From: Vincent Pit <perl@profvince.com>
Date: Fri, 22 Jul 2016 15:50:43 +0000 (-0300)
Subject: Assert that ops reallocated are handled correctly
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fautovivification.git;a=commitdiff_plain;h=95ed68f9af6f78ddec795e51dd3eba75410ca560

Assert that ops reallocated are handled correctly
---

diff --git a/autovivification.xs b/autovivification.xs
index 5844328..23b1f2b 100644
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -343,6 +343,22 @@ static int a_undef(pTHX_ SV *sv) {
  * again. That's why we don't remove the op info from our map, so that it can
  * still run correctly if required. */
 
+#ifdef DEBUGGING
+
+static UV a_cop_hint(pTHX_ COP *cop) {
+#define a_cop_hint(C) a_cop_hint(aTHX_ (C))
+ SV *hint;
+
+ if (!cop)
+  return 0;
+
+ hint = cop_hints_fetch_pvn(cop, XSH_HINTS_KEY, XSH_HINTS_KEY_LEN, xsh_hints_key_hash, 0);
+
+ return hint ? xsh_hints_detag(hint) : 0;
+}
+
+#endif
+
 /* ... pp_rv2av ............................................................ */
 
 static OP *a_pp_rv2av(pTHX) {
@@ -352,16 +368,18 @@ static OP *a_pp_rv2av(pTHX) {
 
  oi = a_map_fetch(PL_op);
 
- if (oi->flags & A_HINT_DEREF) {
-  if (a_undef(TOPs)) {
-   /* We always need to push an empty array to fool the pp_aelem() that comes
-    * later. */
-   SV *av;
-   (void) POPs;
-   av = sv_2mortal((SV *) newAV());
-   PUSHs(av);
-   RETURN;
-  }
+ XSH_ASSERT(a_cop_hint(PL_curcop));
+ XSH_ASSERT(oi->flags & A_HINT_DEREF);
+ XSH_ASSERT(oi->flags & A_HINT_DO);
+
+ if (a_undef(TOPs)) {
+  /* We always need to push an empty array to fool the pp_aelem() that comes
+   * later. */
+  SV *av;
+  (void) POPs;
+  av = sv_2mortal((SV *) newAV());
+  PUSHs(av);
+  RETURN;
  }
 
  return oi->old_pp(aTHX);
@@ -376,10 +394,12 @@ static OP *a_pp_rv2hv_simple(pTHX) {
 
  oi = a_map_fetch(PL_op);
 
- if (oi->flags & A_HINT_DEREF) {
-  if (a_undef(TOPs))
-   RETURN;
- }
+ XSH_ASSERT(a_cop_hint(PL_curcop));
+ XSH_ASSERT(oi->flags & A_HINT_DEREF);
+ XSH_ASSERT(oi->flags & A_HINT_DO);
+
+ if (a_undef(TOPs))
+  RETURN;
 
  return oi->old_pp(aTHX);
 }
@@ -391,14 +411,16 @@ static OP *a_pp_rv2hv(pTHX) {
 
  oi = a_map_fetch(PL_op);
 
- if (oi->flags & A_HINT_DEREF) {
-  if (a_undef(TOPs)) {
-   SV *hv;
-   (void) POPs;
-   hv = sv_2mortal((SV *) newHV());
-   PUSHs(hv);
-   RETURN;
-  }
+ XSH_ASSERT(a_cop_hint(PL_curcop));
+ XSH_ASSERT(oi->flags & A_HINT_DEREF);
+ XSH_ASSERT(oi->flags & (A_HINT_FETCH|A_HINT_STORE));
+
+ if (a_undef(TOPs)) {
+  SV *hv;
+  (void) POPs;
+  hv = sv_2mortal((SV *) newHV());
+  PUSHs(hv);
+  RETURN;
  }
 
  return oi->old_pp(aTHX);
@@ -420,26 +442,25 @@ static OP *a_pp_deref(pTHX) {
  dA_MAP_THX;
  const a_op_info *oi;
  UV flags;
+ OP *o;
  dSP;
 
  oi = a_map_fetch(PL_op);
 
+ XSH_ASSERT(a_cop_hint(PL_curcop));
  flags = oi->flags;
- if (flags & A_HINT_DEREF) {
-  OP *o;
+ XSH_ASSERT(oi->flags & A_HINT_DEREF);
+ XSH_ASSERT(oi->flags & A_HINT_DO);
 
-  o = oi->old_pp(aTHX);
+ o = oi->old_pp(aTHX);
 
-  if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
-   SPAGAIN;
-   if (a_undef(TOPs))
-    a_cannot_vivify(flags);
-  }
-
-  return o;
+ if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
+  SPAGAIN;
+  if (a_undef(TOPs))
+   a_cannot_vivify(flags);
  }
 
- return oi->old_pp(aTHX);
+ return o;
 }
 
 /* ... pp_root (exists,delete,keys,values) ................................. */
@@ -599,13 +620,14 @@ static OP *a_pp_multideref(pTHX) {
  SV *sv    = NULL;
  dSP;
 
+ XSH_ASSERT(a_cop_hint(PL_curcop));
+
  {
   dA_MAP_THX;
   const a_op_info *oi = a_map_fetch(PL_op);
   XSH_ASSERT(oi);
   flags = a_do_multideref(PL_op, oi->flags);
-  if (!flags)
-   return oi->old_pp(aTHX);
+  XSH_ASSERT(flags & A_HINT_DO);
  }
 
  items   = cUNOP_AUXx(PL_op)->op_aux;
@@ -1028,6 +1050,10 @@ static OP *a_ck_root(pTHX_ OP *o) {
 /* --- Our peephole optimizer ---------------------------------------------- */
 
 static void xsh_peep_rec(pTHX_ OP *o, ptable *seen) {
+#ifdef DEBUGGING
+ COP *last_cop = NULL;
+#endif
+
  for (; o; o = o->op_next) {
   dA_MAP_THX;
   const a_op_info *oi = NULL;
@@ -1037,11 +1063,20 @@ static void xsh_peep_rec(pTHX_ OP *o, ptable *seen) {
    break;
 
   switch (o->op_type) {
+#ifdef DEBUGGING
+   case OP_NEXTSTATE:
+   case OP_DBSTATE:
+    last_cop = o;
+    break;
+#endif
    case OP_PADSV:
     if (o->op_ppaddr != a_pp_deref) {
      oi = a_map_fetch(o);
      if (oi && (oi->flags & A_HINT_DO)) {
       a_map_store(o, o->op_ppaddr, oi->next, oi->flags);
+#ifdef DEBUGGING
+      XSH_ASSERT(!last_cop || a_cop_hint(last_cop));
+#endif
       o->op_ppaddr = a_pp_deref;
      }
     }
diff --git a/samples/stress_realloc.pl b/samples/stress_realloc.pl
new file mode 100644
index 0000000..694e9a0
--- /dev/null
+++ b/samples/stress_realloc.pl
@@ -0,0 +1,28 @@
+#!perl
+
+use strict;
+use warnings;
+use blib;
+
+my $n = 1_000;
+my $p = 100;
+
+my $test = <<'TEST';
+ my $e = $x->{foo}[0]{bar};
+ delete $x->{a}[1]{b};
+ exists $x->{x}[2]{y};
+TEST
+
+for (1 .. $n) {
+ my $x;
+ my $r = eval <<" CODE";
+  no autovivification;
+  $test
+ CODE
+ die $@ if $@ or defined $x;
+ for (1 .. $p) {
+  my $x;
+  my $r = eval $test;
+  die $@ if $@;
+ }
+}