From: Vincent Pit <vince@profvince.com>
Date: Fri, 19 Jun 2009 22:09:02 +0000 (+0200)
Subject: Also handle old-style dereferencing "$$hashref{key}"
X-Git-Tag: v0.03~3
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fautovivification.git;a=commitdiff_plain;h=942e958277b7cb1bc8044adb2c193a1f31757588

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

diff --git a/autovivification.xs b/autovivification.xs
index a71eb64..04725c4 100644
--- 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 760f9e1..fa16a37 100644
--- 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 47c7b41..a965ed2 100644
--- 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 c6be2aa..feea9eb 100644
--- 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 2930304..1adab77 100644
--- 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 19ce7ea..99d6672 100644
--- 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]) {