X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=autovivification.xs;h=7e7c1f34cd32fbb5a684c6d21695537bdd327fa1;hb=refs%2Ftags%2Frt56870;hp=ae8db121e2527d6c57bfdc0b0511111068ecb857;hpb=68e31f8ce73ddedf82977b4e05ec550c1cfe5688;p=perl%2Fmodules%2Fautovivification.git

diff --git a/autovivification.xs b/autovivification.xs
index ae8db12..7e7c1f3 100644
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -33,13 +33,10 @@
  while (len > 0)                 \
   (U) = ((U) << 8) | (B)[--len];
 
-STATIC SV *a_tag(pTHX_ UV bits) {
-#define a_tag(B) a_tag(aTHX_ (B))
- SV            *hint;
+#if A_WORKAROUND_REQUIRE_PROPAGATION
+STATIC UV a_require_tag(pTHX) {
+#define a_require_tag() a_require_tag(aTHX)
  const PERL_SI *si;
- UV             requires = 0;
- unsigned char  buf[sizeof(UV) * 2];
- STRLEN         len;
 
  for (si = PL_curstackinfo; si; si = si->si_prev) {
   I32 cxix;
@@ -48,11 +45,24 @@ STATIC SV *a_tag(pTHX_ UV bits) {
    const PERL_CONTEXT *cx = si->si_cxstack + cxix;
 
    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
-    ++requires;
+    return PTR2UV(cx);
   }
  }
 
- A_ENCODE_UV(buf,              requires);
+ return PTR2UV(NULL);
+}
+#endif /* A_WORKAROUND_REQUIRE_PROPAGATION */
+
+STATIC SV *a_tag(pTHX_ UV bits) {
+#define a_tag(B) a_tag(aTHX_ (B))
+ SV            *hint;
+ const PERL_SI *si;
+ UV             cxreq;
+ unsigned char  buf[sizeof(UV) * 2];
+ STRLEN         len;
+
+ cxreq = a_require_tag();
+ A_ENCODE_UV(buf,              cxreq);
  A_ENCODE_UV(buf + sizeof(UV), bits);
  hint = newSVpvn(buf, sizeof buf);
  SvREADONLY_on(hint);
@@ -63,7 +73,7 @@ STATIC SV *a_tag(pTHX_ UV bits) {
 STATIC UV a_detag(pTHX_ const SV *hint) {
 #define a_detag(H) a_detag(aTHX_ (H))
  const PERL_SI *si;
- UV             requires = 0, requires_max = 0, bits = 0;
+ UV             cxreq = 0, bits = 0;
  unsigned char *buf;
  STRLEN         len;
 
@@ -71,21 +81,12 @@ STATIC UV a_detag(pTHX_ const SV *hint) {
   return 0;
 
  buf = SvPVX(hint);
- A_DECODE_UV(requires_max, buf);
-
- for (si = PL_curstackinfo; si; si = si->si_prev) {
-  I32 cxix;
-
-  for (cxix = si->si_cxix; cxix >= 0; --cxix) {
-   const PERL_CONTEXT *cx = si->si_cxstack + cxix;
 
-   if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE
-                              && ++requires > requires_max)
-    return 0;
-  }
- }
+ A_DECODE_UV(cxreq, buf);
+ if (a_require_tag() != cxreq)
+  return 0;
 
- A_DECODE_UV(bits, buf + sizeof(UV));
+ A_DECODE_UV(bits,  buf + sizeof(UV));
 
  return bits;
 }
@@ -93,7 +94,18 @@ STATIC UV a_detag(pTHX_ const SV *hint) {
 #else /* A_WORKAROUND_REQUIRE_PROPAGATION */
 
 #define a_tag(B)   newSVuv(B)
-#define a_detag(H) (((H) && SvOK(H)) ? SvUVX(H) : 0)
+/* PVs fetched from the hints chain have their SvLEN set to zero, so get the UV
+ * from a copy. */
+#define a_detag(H) \
+ ((H)              \
+  ? (SvIOK(H)      \
+     ? SvUVX(H)    \
+     : (SvPOK(H)   \
+        ? sv_2uv(SvLEN(H) ? (H) : sv_mortalcopy(H)) \
+	: 0        \
+       )           \
+     )             \
+  : 0)
 
 #endif /* !A_WORKAROUND_REQUIRE_PROPAGATION */
 
@@ -366,7 +378,9 @@ STATIC bool a_defined(pTHX_ SV *sv) {
     defined = TRUE;
    break;
   default:
-   defined = SvOK(sv);
+   SvGETMAGIC(sv);
+   if (SvOK(sv))
+    defined = TRUE;
  }
 
  return defined;
@@ -391,7 +405,7 @@ STATIC OP *a_pp_rv2av(pTHX) {
  flags = oi.flags;
 
  if (flags & A_HINT_DEREF) {
-  if (!SvOK(TOPs)) {
+  if (!a_defined(TOPs)) {
    /* We always need to push an empty array to fool the pp_aelem() that comes
     * later. */
    SV *av;
@@ -418,7 +432,7 @@ STATIC OP *a_pp_rv2hv_simple(pTHX) {
  flags = oi.flags;
 
  if (flags & A_HINT_DEREF) {
-  if (!SvOK(TOPs))
+  if (!a_defined(TOPs))
    RETURN;
  } else {
   PL_op->op_ppaddr = oi.old_pp;
@@ -436,7 +450,7 @@ STATIC OP *a_pp_rv2hv(pTHX) {
  flags = oi.flags;
 
  if (flags & A_HINT_DEREF) {
-  if (!SvOK(TOPs)) {
+  if (!a_defined(TOPs)) {
    SV *hv;
    POPs;
    hv = sv_2mortal((SV *) newHV());
@@ -472,7 +486,7 @@ deref:
 
   if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
    SPAGAIN;
-   if (!SvOK(TOPs)) {
+   if (!a_defined(TOPs)) {
     if (flags & A_HINT_STRICT)
      croak("Reference vivification forbidden");
     else if (flags & A_HINT_WARN)