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 8933e7a6e6ffcb1933199af528b4a75a3b4d34bf..91ba46a8cddfd1f8c439ba63158c517970d995b5 100644 (file)
--- 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 5d189a0524e65e13489b7ec460b8b7ef189f1118..5e42f1f1719c7fc4cb01198b9639d50194a026aa 100644 (file)
--- 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 e7a1703e9508e5b7b4f89bf4c77b630ef5e2d9c7..760f9e14183cb452c8436ea2d02ec71f0bb47425 100644 (file)
--- 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 744c4927549ff2bb3a2399d3bda5af4a3cc078d8..2930304683b5f42810e973916550222eecd4a031 100644 (file)
--- 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