From: Vincent Pit <perl@profvince.com>
Date: Mon, 31 Jul 2017 14:46:17 +0000 (+0200)
Subject: Fix autovivification for scalar(keys(%)) in perl 5.27.3
X-Git-Tag: v0.17~5
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=d63177dc692833e3fc3604ce8d52fd9922ea31db;p=perl%2Fmodules%2Fautovivification.git

Fix autovivification for scalar(keys(%)) in perl 5.27.3
---

diff --git a/autovivification.xs b/autovivification.xs
index ddc4dd7..a744b79 100644
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -32,7 +32,8 @@
 
 /* Only used in op flags */
 #define A_HINT_ROOT   256
-#define A_HINT_DEREF  512
+#define A_HINT_SECOND 512
+#define A_HINT_DEREF  1024
 
 #define XSH_HINTS_TYPE_UV 1
 
@@ -61,6 +62,10 @@
 # define A_HAS_MULTIDEREF XSH_HAS_PERL(5, 21, 7)
 #endif
 
+#ifndef A_HAS_SCALARKEYS_OPT
+# define A_HAS_SCALARKEYS_OPT XSH_HAS_PERL(5, 27, 3)
+#endif
+
 /* ... Our vivify_ref() .................................................... */
 
 /* Perl_vivify_ref() is not exported, so we have to reimplement it. */
@@ -243,7 +248,7 @@ static void a_map_update_flags_topdown(const OP *root, UV flags) {
 
  do {
   if ((oi = ptable_fetch(a_op_map, o)))
-   oi->flags = (oi->flags & A_HINT_ROOT) | flags;
+   oi->flags = (oi->flags & (A_HINT_ROOT|A_HINT_SECOND)) | flags;
   if (!(o->op_flags & OPf_KIDS))
    break;
   o = a_map_descend(o);
@@ -408,6 +413,29 @@ static OP *a_pp_rv2hv(pTHX) {
  return oi->old_pp(aTHX);
 }
 
+#if A_HAS_SCALARKEYS_OPT
+
+static OP *a_pp_rv2hv_dokeys(pTHX) {
+ dA_MAP_THX;
+ const a_op_info *oi;
+ dSP;
+
+ oi = a_map_fetch(PL_op);
+
+ if (oi->flags & A_HINT_KEYS) {
+  if (a_undef(TOPs)) {
+   dTARGET;
+   (void) POPs;
+   PUSHi(0);
+   RETURN;
+  }
+ }
+
+ return oi->old_pp(aTHX);
+}
+
+#endif
+
 /* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
 
 static void a_cannot_vivify(pTHX_ UV flags) {
@@ -1017,6 +1045,19 @@ static OP *a_ck_root(pTHX_ OP *o) {
 
  if (hint & A_HINT_DO) {
   if (enabled) {
+#if A_HAS_SCALARKEYS_OPT
+   if ((enabled == A_HINT_KEYS) && (o->op_flags & OPf_KIDS)) {
+    OP *kid = cUNOPo->op_first;
+    if (kid->op_type == OP_RV2HV) {
+     dA_MAP_THX;
+     const a_op_info *koi = a_map_fetch(kid);
+     a_map_store(kid, koi ? koi->old_pp : kid->op_ppaddr, NULL,
+                      hint | A_HINT_SECOND);
+     if (!koi)
+      kid->op_ppaddr = a_pp_rv2hv;
+    }
+   }
+#endif
    a_map_update_flags_topdown(o, hint | A_HINT_DEREF);
    a_map_store_root(o, o->op_ppaddr, hint);
    o->op_ppaddr = new_pp;
@@ -1072,16 +1113,34 @@ static void xsh_peep_rec(pTHX_ OP *o, ptable *seen) {
      o->op_ppaddr  = oi->old_pp;
     break;
    case OP_RV2AV:
-   case OP_RV2HV:
-    if (   o->op_ppaddr != a_pp_rv2av
-        && o->op_ppaddr != a_pp_rv2hv
-        && o->op_ppaddr != a_pp_rv2hv_simple)
+    if (o->op_ppaddr != a_pp_rv2av)
      break;
     oi = a_map_fetch(o);
     if (!oi)
      break;
     if (!(oi->flags & A_HINT_DEREF))
-     o->op_ppaddr  = oi->old_pp;
+     o->op_ppaddr = oi->old_pp;
+    break;
+   case OP_RV2HV:
+    if (o->op_ppaddr != a_pp_rv2hv && o->op_ppaddr != a_pp_rv2hv_simple)
+     break;
+    oi = a_map_fetch(o);
+    if (!oi)
+     break;
+    if (!(oi->flags & A_HINT_DEREF)) {
+     o->op_ppaddr = oi->old_pp;
+     break;
+    }
+#if A_HAS_SCALARKEYS_OPT
+    flags = oi->flags;
+    if ((flags & A_HINT_KEYS) && (flags & A_HINT_SECOND)) {
+     U8 want = o->op_flags & OPf_WANT;
+     if (want == OPf_WANT_VOID || want == OPf_WANT_SCALAR)
+      o->op_ppaddr = a_pp_rv2hv_dokeys;
+     else if (oi->old_pp == a_pp_rv2hv || oi->old_pp == a_pp_rv2hv_simple)
+      o->op_ppaddr = oi->old_pp;
+    }
+#endif
     break;
 #if A_HAS_MULTIDEREF
    case OP_MULTIDEREF: