Prefer -std=c89 over -ansi.

[perl5.git] / pad.c

diff --git a/pad.c b/pad.c
index e45b544..a9581f8 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -167,16 +167,16 @@ sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U3
         STRLEN cur1     = SvCUR(sv);
         const char *pv2 = pv;
         STRLEN cur2     = pvlen;
-       if (PL_encoding) {
+       if (IN_ENCODING) {
               SV* svrecode = NULL;
              if (SvUTF8(sv)) {
                   svrecode = newSVpvn(pv2, cur2);
-                  sv_recode_to_utf8(svrecode, PL_encoding);
+                  sv_recode_to_utf8(svrecode, _get_encoding());
                   pv2      = SvPV_const(svrecode, cur2);
              }
              else {
                   svrecode = newSVpvn(pv1, cur1);
-                  sv_recode_to_utf8(svrecode, PL_encoding);
+                  sv_recode_to_utf8(svrecode, _get_encoding());
                   pv1      = SvPV_const(svrecode, cur1);
              }
               SvREFCNT_dec_NN(svrecode);
@@ -197,7 +197,7 @@ sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U3
 
 #ifdef DEBUGGING
 void
-Perl_set_padlist(pTHX_ CV * cv, PADLIST *padlist){
+Perl_set_padlist(CV * cv, PADLIST *padlist){
     PERL_ARGS_ASSERT_SET_PADLIST;
 #  if PTRSIZE == 8
     if((Size_t)padlist == UINT64_C(0xEFEFEFEFEFEFEFEF)){
@@ -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;
@@ -2155,7 +2128,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
                        CvNAME_HEK_set(
                            sv,
                            share_hek(SvPVX_const(namesv)+1,
-                                     SvCUR(namesv) - 1
+                                     (SvCUR(namesv) - 1)
                                         * (SvUTF8(namesv) ? -1 : 1),
                                      hash)
                        );
@@ -2213,6 +2186,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
         * 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))
@@ -2240,20 +2214,32 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
                         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;
                }
            }
-           /* We *copy* the lexical variable, and donate the copy to
-              newCONSTSUB.  Yes, this is ugly, and should be killed.
-              XXX Is it possible to eliminate this now?  */
-           const_sv = newSVsv(const_sv);
+           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.  */
+           SvREADONLY_on(const_sv);
            SvPADTMP_on(const_sv);
            SvREFCNT_dec_NN(cv);
            cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);