From: Vincent Pit <vince@profvince.com>
Date: Thu, 18 Jun 2009 17:54:35 +0000 (+0200)
Subject: Classify aliasing constructs in the "store" category
X-Git-Tag: v0.03~9
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=b47bb780966680623d37ce471e44f64ae12a5863;p=perl%2Fmodules%2Fautovivification.git

Classify aliasing constructs in the "store" category

There's no way to guess at compile time if the scalar will be modified, such as in "eval '$_ = 1' for $x->{key}". Practically, there's no way to distinguish the xelem op from the one you get for "$x->{key} = $val". I was going against the interpreter's will and this is my defeat.

This commit partially reverts ddbfd527f4c54458985145aae3a837a8f5868551.
---

diff --git a/autovivification.xs b/autovivification.xs
index 8933e7a..91ba46a 100644
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -299,12 +299,6 @@ STATIC OP *a_pp_rv2hv(pTHX) {
  if (PL_op == oi.root) { /* This means "%$hashref" */
   PL_op->op_ppaddr = oi.old_pp;
  } else if (!SvOK(TOPs)) {
-  if (oi.root->op_flags & OPf_MOD) {
-   SV *hv;
-   POPs;
-   hv = sv_2mortal((SV *) newHV());
-   PUSHs(hv);
-  }
   RETURN;
  }
 
@@ -347,11 +341,11 @@ deref:
  } else if (flags && (PL_op->op_private & OPpDEREF || PL_op == oi.root)) {
   oi.flags = flags & A_HINT_NOTIFY;
 
-  if ((oi.root->op_flags & (OPf_MOD|OPf_REF)) != (OPf_MOD|OPf_REF)) {
-   if (flags & A_HINT_FETCH)
-    oi.flags |= (A_HINT_FETCH|A_HINT_DEREF);
-  } else if (flags & A_HINT_STORE)
+  if (oi.root->op_flags & OPf_MOD) {
+   if (flags & A_HINT_STORE)
     oi.flags |= (A_HINT_STORE|A_HINT_DEREF);
+  } else if (flags & A_HINT_FETCH)
+    oi.flags |= (A_HINT_FETCH|A_HINT_DEREF);
 
   if (PL_op == oi.root)
    oi.flags &= ~A_HINT_DEREF;
diff --git a/lib/autovivification.pm b/lib/autovivification.pm
index 5d189a0..5e42f1f 100644
--- a/lib/autovivification.pm
+++ b/lib/autovivification.pm
@@ -85,7 +85,7 @@ C<undef> is returned when the expression would have autovivified.
 
 C<'store'>
 
-Turn off autovivification for lvalue dereferencing expressions, such as C<< $hashref->{key}[$idx]{$field} = $value >>.
+Turn off autovivification for lvalue dereferencing expressions, such as C<< $hashref->{key}[$idx]{$field} = $value >> or C<< for ($hashref->{key}[$idx]{$field}) { ... } >>.
 An exception is thrown if vivification is needed to store the value, which means that effectively you can only assign to levels that are already defined (in the example, this would require C<< $hashref->{key}[$idx] >> to already be a hash reference).
 
 =item *
diff --git a/t/20-hash.t b/t/20-hash.t
index e7a1703..760f9e1 100644
--- a/t/20-hash.t
+++ b/t/20-hash.t
@@ -94,18 +94,18 @@ $x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } }
 --- aliasing ---
 
 $x # 1 for $x->{a}; () # '', undef, { a => undef }
-$x # 1 for $x->{a}; () # '', undef, undef          #
-$x # 1 for $x->{a}; () # '', undef, undef          # +fetch
+$x # 1 for $x->{a}; () # '', undef, { a => undef } #
+$x # 1 for $x->{a}; () # '', undef, { a => undef } # +fetch
 $x # 1 for $x->{a}; () # '', undef, { a => undef } # +exists
 $x # 1 for $x->{a}; () # '', undef, { a => undef } # +delete
-$x # 1 for $x->{a}; () # '', undef, { a => undef } # +store
+$x # 1 for $x->{a}; () # qr/^Can't vivify reference/, undef, undef # +store
 
 $x # $_ = 1 for $x->{a}; () # '', undef, { a => 1 }
-$x # $_ = 1 for $x->{a}; () # '', undef, undef      #
-$x # $_ = 1 for $x->{a}; () # '', undef, undef      # +fetch
+$x # $_ = 1 for $x->{a}; () # '', undef, { a => 1 } #
+$x # $_ = 1 for $x->{a}; () # '', undef, { a => 1 } # +fetch
 $x # $_ = 1 for $x->{a}; () # '', undef, { a => 1 } # +exists
 $x # $_ = 1 for $x->{a}; () # '', undef, { a => 1 } # +delete
-$x # $_ = 1 for $x->{a}; () # '', undef, { a => 1 } # +store
+$x # $_ = 1 for $x->{a}; () # qr/^Can't vivify reference/, undef, undef # +store
 
 $x->{a} = 1 # 1 for $x->{a}; () # '', undef, { a => 1 }             # +fetch
 $x->{a} = 1 # 1 for $x->{b}; () # '', undef, { a => 1, b => undef } # +fetch
diff --git a/t/21-array.t b/t/21-array.t
index 744c492..2930304 100644
--- a/t/21-array.t
+++ b/t/21-array.t
@@ -94,18 +94,18 @@ $x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +str
 --- aliasing ---
 
 $x # 1 for $x->[0]; () # '', undef, [ undef ]
-$x # 1 for $x->[0]; () # '', undef, undef #
-$x # 1 for $x->[0]; () # '', undef, undef # +fetch
+$x # 1 for $x->[0]; () # '', undef, [ undef ] #
+$x # 1 for $x->[0]; () # '', undef, [ undef ] # +fetch
 $x # 1 for $x->[0]; () # '', undef, [ undef ] # +exists
 $x # 1 for $x->[0]; () # '', undef, [ undef ] # +delete
-$x # 1 for $x->[0]; () # '', undef, [ undef ] # +store
+$x # 1 for $x->[0]; () # qr/^Can't vivify reference/, undef, undef # +store
 
 $x # $_ = 1 for $x->[0]; () # '', undef, [ 1 ]
-$x # $_ = 1 for $x->[0]; () # '', undef, undef #
-$x # $_ = 1 for $x->[0]; () # '', undef, undef # +fetch
+$x # $_ = 1 for $x->[0]; () # '', undef, [ 1 ] #
+$x # $_ = 1 for $x->[0]; () # '', undef, [ 1 ] # +fetch
 $x # $_ = 1 for $x->[0]; () # '', undef, [ 1 ] # +exists
 $x # $_ = 1 for $x->[0]; () # '', undef, [ 1 ] # +delete
-$x # $_ = 1 for $x->[0]; () # '', undef, [ 1 ] # +store
+$x # $_ = 1 for $x->[0]; () # qr/^Can't vivify reference/, undef, undef # +store
 
 $x->[0] = 1 # 1 for $x->[0]; () # '', undef, [ 1 ] # +fetch
 $x->[0] = 1 # 1 for $x->[1]; () # '', undef, [ 1, undef ] # +fetch