Put PL_cop_seqmax++ code in one spot

[perl5.git] / pad.c

diff --git a/pad.c b/pad.c
index ff6fbd8..1533ec5 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1233,31 +1233,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                    fake_offset = offset; /* in case we don't find a real one */
                    continue;
                }
-               /* is seq within the range _LOW to _HIGH ?
-                * This is complicated by the fact that PL_cop_seqmax
-                * may have wrapped around at some point */
-               if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
-                   continue; /* not yet introduced */
-
-               if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
-                   /* in compiling scope */
-                   if (
-                       (seq >  COP_SEQ_RANGE_LOW(namesv))
-                       ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
-                       : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
-                   )
-                      break;
-               }
-               else if (
-                   (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
-                   ?
-                       (  seq >  COP_SEQ_RANGE_LOW(namesv)
-                       || seq <= COP_SEQ_RANGE_HIGH(namesv))
-
-                   :    (  seq >  COP_SEQ_RANGE_LOW(namesv)
-                        && seq <= COP_SEQ_RANGE_HIGH(namesv))
-               )
-               break;
+               if (PadnameIN_SCOPE(namesv, seq))
+                   break;
            }
        }
 
@@ -1594,9 +1571,7 @@ Perl_intro_my(pTHX)
            );
        }
     }
-    PL_cop_seqmax++;
-    if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
-       PL_cop_seqmax++;
+    COP_SEQMAX_INC;
     PL_min_intro_pending = 0;
     PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@ -1654,9 +1629,7 @@ Perl_pad_leavemy(pTHX)
            }
        }
     }
-    PL_cop_seqmax++;
-    if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
-       PL_cop_seqmax++;
+    COP_SEQMAX_INC;
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
     return o;
@@ -2201,20 +2174,79 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
         * so try to grab the current const value, and if successful,
         * turn into a const sub:
         */
-       SV* const const_sv = op_const_sv(CvSTART(cv), cv, outside);
+       SV* const_sv;
+       OP *o = CvSTART(cv);
        assert(newcv);
-       if (const_sv) {
+       for (; o; o = o->op_next)
+           if (o->op_type == OP_PADSV)
+               break;
+       ASSUME(o->op_type == OP_PADSV);
+       const_sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
+       /* the candidate should have 1 ref from this pad and 1 ref
+        * from the parent */
+       if (const_sv && SvREFCNT(const_sv) == 2) {
            const bool was_method = cBOOL(CvMETHOD(cv));
+           bool copied = FALSE;
+           if (outside) {
+               PADNAME * const pn =
+                   PadlistNAMESARRAY(CvPADLIST(outside))
+                       [PARENT_PAD_INDEX(PadlistNAMESARRAY(
+                           CvPADLIST(cv))[o->op_targ])];
+               assert(PadnameOUTER(PadlistNAMESARRAY(CvPADLIST(cv))
+                                       [o->op_targ]));
+               if (PadnameLVALUE(pn)) {
+                   /* We have a lexical that is potentially modifiable
+                      elsewhere, so making a constant will break clo-
+                      sure behaviour.  If this is a ‘simple lexical
+                      op tree’, i.e., sub(){$x}, emit a deprecation
+                      warning, but continue to exhibit the old behav-
+                      iour of making it a constant based on the ref-
+                      count of the candidate variable.
+
+                      A simple lexical op tree looks like this:
+
+                        leavesub
+                          lineseq
+                            nextstate
+                            padsv
+                    */
+                   if (OP_SIBLING(
+                        cUNOPx(cUNOPx(CvROOT(cv))->op_first)->op_first
+                       ) == o
+                    && !OP_SIBLING(o))
+                   {
+                       Perl_ck_warner_d(aTHX_
+                                         packWARN(WARN_DEPRECATED),
+                                        "Constants from lexical "
+                                        "variables potentially "
+                                        "modified elsewhere are "
+                                        "deprecated");
+                       /* We *copy* the lexical variable, and donate the
+                          copy to newCONSTSUB.  Yes, this is ugly, and
+                          should be killed.  We need to do this for the
+                          time being, however, because turning on SvPADTMP
+                          on a lexical will have observable effects
+                          elsewhere.  */
+                       const_sv = newSVsv(const_sv);
+                       copied = TRUE;
+                   }
+                   else
+                       goto constoff;
+               }
+           }
+           if (!copied)
+               SvREFCNT_inc_simple_void_NN(const_sv);
+           /* If the lexical is not used elsewhere, it is safe to turn on
+              SvPADTMP, since it is only when it is used in lvalue con-
+              text that the difference is observable.  */
+           SvPADTMP_on(const_sv);
            SvREFCNT_dec_NN(cv);
-           /* For this calling case, op_const_sv returns a *copy*, which
-              we donate to newCONSTSUB. Yes, this is ugly, and should be
-              killed.  We need to fix how we decide whether this optimisa-
-              tion is possible to eliminate this.  */
            cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
            if (was_method)
                CvMETHOD_on(cv);
        }
        else {
+         constoff:
            CvCONST_off(cv);
        }
     }