X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=autovivification.xs;h=a744b79be8a735ef0c47af4c153597cb92a4a7e9;hb=d63177dc692833e3fc3604ce8d52fd9922ea31db;hp=34cd2da1d2f95747a38c518f1b58063fd2966d8d;hpb=fdfce5eb8dd5546bb8cbcd946c68b6d72068feee;p=perl%2Fmodules%2Fautovivification.git

diff --git a/autovivification.xs b/autovivification.xs
index 34cd2da..a744b79 100644
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -22,15 +22,18 @@
 #define A_HINT_WARN   2
 #define A_HINT_FETCH  4
 #define A_HINT_STORE  8
-#define A_HINT_EXISTS 16
-#define A_HINT_DELETE 32
+#define A_HINT_KEYS   16
+#define A_HINT_VALUES 32
+#define A_HINT_EXISTS 64
+#define A_HINT_DELETE 128
 #define A_HINT_NOTIFY (A_HINT_STRICT|A_HINT_WARN)
-#define A_HINT_DO     (A_HINT_FETCH|A_HINT_STORE|A_HINT_EXISTS|A_HINT_DELETE)
+#define A_HINT_DO     (A_HINT_FETCH|A_HINT_STORE|A_HINT_KEYS|A_HINT_VALUES|A_HINT_EXISTS|A_HINT_DELETE)
 #define A_HINT_MASK   (A_HINT_NOTIFY|A_HINT_DO)
 
 /* Only used in op flags */
-#define A_HINT_ROOT   64
-#define A_HINT_DEREF  128
+#define A_HINT_ROOT   256
+#define A_HINT_SECOND 512
+#define A_HINT_DEREF  1024
 
 #define XSH_HINTS_TYPE_UV 1
 
@@ -59,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. */
@@ -241,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);
@@ -294,8 +301,10 @@ static UV a_map_resolve(const OP *o, const a_op_info *oi) {
  if (root->op_flags & OPf_MOD) {
   if (rflags & A_HINT_STORE)
    flags = (A_HINT_STORE|A_HINT_DEREF);
- } else if (rflags & A_HINT_FETCH)
-   flags = (A_HINT_FETCH|A_HINT_DEREF);
+ } else {
+  if (rflags & (A_HINT_FETCH|A_HINT_KEYS|A_HINT_VALUES))
+   flags = (rflags|A_HINT_DEREF);
+ }
 
  if (!flags) {
 cancel:
@@ -404,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) {
@@ -1001,18 +1033,31 @@ static OP *a_ck_root(pTHX_ OP *o) {
   case OP_KEYS:
    old_ck  = a_old_ck_keys;
    new_pp  = a_pp_root_unop;
-   enabled = hint & A_HINT_FETCH;
+   enabled = hint & A_HINT_KEYS;
    break;
   case OP_VALUES:
    old_ck  = a_old_ck_values;
    new_pp  = a_pp_root_unop;
-   enabled = hint & A_HINT_FETCH;
+   enabled = hint & A_HINT_VALUES;
    break;
  }
  o = old_ck(aTHX_ 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;
@@ -1068,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:
@@ -1138,6 +1201,8 @@ static void xsh_user_local_setup(pTHX) {
  newCONSTSUB(stash, "A_HINT_WARN",   newSVuv(A_HINT_WARN));
  newCONSTSUB(stash, "A_HINT_FETCH",  newSVuv(A_HINT_FETCH));
  newCONSTSUB(stash, "A_HINT_STORE",  newSVuv(A_HINT_STORE));
+ newCONSTSUB(stash, "A_HINT_KEYS",   newSVuv(A_HINT_KEYS));
+ newCONSTSUB(stash, "A_HINT_VALUES", newSVuv(A_HINT_VALUES));
  newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
  newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
  newCONSTSUB(stash, "A_HINT_MASK",   newSVuv(A_HINT_MASK));