Clarify FIRSTKEY and NEXTKEY usage.

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index a6c65c2..bed0a27 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1019,11 +1019,19 @@ S_do_oddball(pTHX_ SV **oddkey, SV **firstkey)
  *
  * If the LHS element is a 'my' declaration' and has a refcount of 1, then
  * it can't be common and can be skipped.
+ *
+ * On DEBUGGING builds it takes an extra boolean, fake. If true, it means
+ * that we thought we didn't need to call S_aassign_copy_common(), but we
+ * have anyway for sanity checking. If we find we need to copy, then panic.
  */
 
 PERL_STATIC_INLINE void
 S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
-        SV **firstrelem, SV **lastrelem)
+        SV **firstrelem, SV **lastrelem
+#ifdef DEBUGGING
+        , bool fake
+#endif
+)
 {
     dVAR;
     SV **relem;
@@ -1036,14 +1044,13 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
     assert(firstlelem < lastlelem); /* at least 2 LH elements */
     assert(firstrelem < lastrelem); /* at least 2 RH elements */
 
+
+    lelem = firstlelem;
     /* we never have to copy the first RH element; it can't be corrupted
      * by assigning something to the corresponding first LH element.
      * So this scan does in a loop: mark LHS[N]; test RHS[N+1]
      */
-    firstrelem++;
-
-    lelem = firstlelem;
-    relem = firstrelem;
+    relem = firstrelem + 1;
 
     for (; relem <= lastrelem; relem++) {
         SV *svr;
@@ -1093,6 +1100,15 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
 
         if (UNLIKELY(SvFLAGS(svr) & SVf_BREAK)) {
 
+#ifdef DEBUGGING
+            if (fake) {
+                /* op_dump(PL_op); */
+                Perl_croak(aTHX_
+                    "panic: aassign skipped needed copy of common RH elem %"
+                        UVuf, (UV)(relem - firstrelem));
+            }
+#endif
+
             TAINT_NOT; /* Each item is independent */
 
             /* Dear TODO test in t/op/sort.t, I love you.
@@ -1106,8 +1122,13 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
              * disabled... */
             SvFLAGS(svr) &= ~SVf_BREAK;
             /* Not newSVsv(), as it does not allow copy-on-write,
-               resulting in wasteful copies.  We need a second copy of
-               a temp here, hence the SV_NOSTEAL.  */
+               resulting in wasteful copies.
+               Also, we use SV_NOSTEAL in case the SV is used more than
+               once, e.g.  (...) = (f())[0,0]
+               Where the same SV appears twice on the RHS without a ref
+               count bump.  (Although I suspect that the SV won't be
+               stealable here anyway - DAPM).
+               */
             *relem = sv_mortalcopy_flags(svr,
                                 SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
             /* ... but restore afterwards in case it's needed again,
@@ -1153,6 +1174,9 @@ PP(pp_aassign)
     SSize_t i;
     int magic;
     U32 lval;
+#ifdef DEBUGGING
+    bool fake = 0;
+#endif
 
     PL_delaymagic = DM_DELAY;          /* catch simultaneous items */
 
@@ -1179,9 +1203,24 @@ PP(pp_aassign)
         else {
           do_scan:
             S_aassign_copy_common(aTHX_
-                        firstlelem, lastlelem, firstrelem, lastrelem);
+                        firstlelem, lastlelem, firstrelem, lastrelem
+#ifdef DEBUGGING
+                        , fake
+#endif
+            );
         }
     }
+#ifdef DEBUGGING
+    else {
+        /* on debugging builds, do the scan even if we've concluded we
+         * don't need to, then panic if we find commonality. Note that the
+         * scanner assumes at least 2 elements */
+        if (firstlelem < lastlelem && firstrelem < lastrelem) {
+            fake = 1;
+            goto do_scan;
+        }
+    }
+#endif
 
     gimme = GIMME_V;
     lval = (gimme == G_ARRAY) ? (PL_op->op_flags & OPf_MOD || LVRET) : 0;
@@ -1227,6 +1266,7 @@ PP(pp_aassign)
                 SV **svp;
                 EXTEND_MORTAL(lastrelem - relem + 1);
                 for (svp = relem; svp <= lastrelem; svp++) {
+                    /* see comment in S_aassign_copy_common about SV_NOSTEAL */
                     *svp = sv_mortalcopy_flags(*svp,
                             SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
                     TAINT_NOT;
@@ -1247,7 +1287,10 @@ PP(pp_aassign)
                             /* before newSV, in case it dies */
                             SvGETMAGIC(*relem);
                         sv = newSV(0);
-                        sv_setsv_nomg(sv, *relem);
+                        /* see comment in S_aassign_copy_common about
+                         * SV_NOSTEAL */
+                        sv_setsv_flags(sv, *relem,
+                                    (SV_DO_COW_SVSETSV|SV_NOSTEAL));
                         *relem = sv;
                     }
                }