Also handle old-style dereferencing "$$hashref{key}"

diff --git a/autovivification.xs b/autovivification.xs
index a71eb6430923c99f7c7ca0521294065eca1193cd..04725c45e66d9ad765cc380c5b6fb40e7b8b9ea0 100644 (file)
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -183,7 +183,10 @@ STATIC const a_op_info *a_map_fetch(const OP *o, a_op_info *oi) {
 #endif
 
  val = ptable_fetch(a_op_map, o);
- *oi = *val;
+ if (val) {
+  *oi = *val;
+  val = oi;
+ }
 
 #ifdef USE_ITHREADS
  MUTEX_UNLOCK(&a_op_map_mutex);
@@ -494,16 +497,41 @@ STATIC OP *(*a_old_ck_rv2sv)(pTHX_ OP *) = 0;
 
 STATIC OP *a_ck_deref(pTHX_ OP *o) {
  OP * (*old_ck)(pTHX_ OP *o) = 0;
- UV hint;
+ UV hint = a_hint();
 
  switch (o->op_type) {
-  case OP_AELEM: old_ck = a_old_ck_aelem; break;
-  case OP_HELEM: old_ck = a_old_ck_helem; break;
-  case OP_RV2SV: old_ck = a_old_ck_rv2sv; break;
+  case OP_AELEM:
+   old_ck = a_old_ck_aelem;
+   if ((hint & A_HINT_DO) && !(hint & A_HINT_STRICT)) {
+    OP *kid = cUNOPo->op_first;
+    a_op_info oi;
+    if (kid->op_type == OP_RV2AV && kid->op_ppaddr != a_pp_rv2av
+                                 && kUNOP->op_first->op_type != OP_GV
+                                 && a_map_fetch(kid, &oi)) {
+     a_map_store(kid, kid->op_ppaddr, hint);
+     kid->op_ppaddr = a_pp_rv2av;
+    }
+   }
+   break;
+  case OP_HELEM:
+   old_ck = a_old_ck_helem;
+   if ((hint & A_HINT_DO) && !(hint & A_HINT_STRICT)) {
+    OP *kid = cUNOPo->op_first;
+    a_op_info oi;
+    if (kid->op_type == OP_RV2HV && kid->op_ppaddr != a_pp_rv2hv
+                                 && kUNOP->op_first->op_type != OP_GV
+                                 && a_map_fetch(kid, &oi)) {
+     a_map_store(kid, kid->op_ppaddr, hint);
+     kid->op_ppaddr = a_pp_rv2hv;
+    }
+   }
+   break;
+  case OP_RV2SV:
+   old_ck = a_old_ck_rv2sv;
+   break;
  }
  o = CALL_FPTR(old_ck)(aTHX_ o);
 
- hint = a_hint();
  if (hint & A_HINT_DO) {
   a_map_store(o, o->op_ppaddr, hint);
   o->op_ppaddr = a_pp_deref;

diff --git a/t/20-hash.t b/t/20-hash.t
index 760f9e14183cb452c8436ea2d02ec71f0bb47425..fa16a375d6cadae30f4499fcfbe3ceece2223dbf 100644 (file)
--- a/t/20-hash.t
+++ b/t/20-hash.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6 * 3 * 274;
+use Test::More tests => 9 * 3 * 274;
 
 use lib 't/lib';
 use autovivification::TestCases;

diff --git a/t/21-hash-specific.t b/t/21-hash-specific.t
index 47c7b41c5b89e1330f95cbe59660b0adce7aa050..a965ed29c94c4a4fce06bbf939da7448d95524ff 100644 (file)
--- a/t/21-hash-specific.t
+++ b/t/21-hash-specific.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6 * 3 * 64;
+use Test::More tests => 9 * 3 * 64;
 
 use lib 't/lib';
 use autovivification::TestCases;

diff --git a/t/30-array.t b/t/30-array.t
index c6be2aa5df8aa7af7d630cef06d9424e51aad274..feea9ebfee9b7218481784004ae4b5b7cff08cca 100644 (file)
--- a/t/30-array.t
+++ b/t/30-array.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6 * 3 * 274;
+use Test::More tests => 9 * 3 * 274;
 
 use lib 't/lib';
 use autovivification::TestCases;

diff --git a/t/31-array-fast.t b/t/31-array-fast.t
index 2930304683b5f42810e973916550222eecd4a031..1adab77b6c6bdcbf88f799b1812f863d19d6c8ce 100644 (file)
--- a/t/31-array-fast.t
+++ b/t/31-array-fast.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6 * 3 * 274;
+use Test::More tests => 9 * 3 * 274;
 
 use lib 't/lib';
 use autovivification::TestCases;

diff --git a/t/lib/autovivification/TestCases.pm b/t/lib/autovivification/TestCases.pm
index 19ce7eadaf0e914de688d6eb86f09891b5d621b5..99d6672a2984d6cc51494108e7998371cd2da4a1 100644 (file)
--- a/t/lib/autovivification/TestCases.pm
+++ b/t/lib/autovivification/TestCases.pm
@@ -62,6 +62,10 @@ sub testcase_ok {
  }
  my @base = ([ $var, $init, $code, $exp, $use ]);
  if ($var =~ /\$/) {
+  my @oldderef = @{$base[0]};
+  $oldderef[2] =~ s/\Q$var\E\->/\$$var/g;
+  push @base, \@oldderef;
+
   my @nonref = @{$base[0]};
   $nonref[0] =~ s/^\$/$sigil/;
   for ($nonref[1], $nonref[2]) {