don't longjmp() in pp_goto() (regressive bug from old single-stack

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 33a9efd..cc79dfe 100644 (file)
--- a/op.c
+++ b/op.c
@@ -35,6 +35,8 @@
         Nullop )                                               \
      : (CHECKCALL[type])((OP*)o))
 
+#define PAD_MAX 999999999
+
 static bool scalar_mod_type _((OP *o, I32 type));
 #ifndef PERL_OBJECT
 static I32 list_assignment _((OP *o));
@@ -131,12 +133,12 @@ pad_allocmy(char *name)
        for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
            if ((sv = svp[off])
                && sv != &PL_sv_undef
-               && SvIVX(sv) == 999999999       /* var is in open scope */
+               && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
                && strEQ(name, SvPVX(sv)))
            {
                warner(WARN_UNSAFE,
-                       "\"my\" variable %s masks earlier declaration in same scope", 
-                       name);
+                       "\"my\" variable %s masks earlier declaration in same %s", 
+                       name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
                break;
            }
        }
@@ -154,7 +156,7 @@ pad_allocmy(char *name)
        PL_sv_objcount++;
     }
     av_store(PL_comppad_name, off, sv);
-    SvNVX(sv) = (double)999999999;
+    SvNVX(sv) = (double)PAD_MAX;
     SvIVX(sv) = 0;                     /* Not yet introduced--see newSTATEOP */
     if (!PL_min_intro_pending)
        PL_min_intro_pending = off;
@@ -216,7 +218,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
                    sv_setpv(namesv, name);
                    av_store(PL_comppad_name, newoff, namesv);
                    SvNVX(namesv) = (double)PL_curcop->cop_seq;
-                   SvIVX(namesv) = 999999999;  /* A ref, intro immediately */
+                   SvIVX(namesv) = PAD_MAX;    /* A ref, intro immediately */
                    SvFAKE_on(namesv);          /* A ref, not a real var */
                    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
                        /* "It's closures all the way down." */
@@ -358,7 +360,7 @@ pad_leavemy(I32 fill)
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
-       if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == 999999999)
+       if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX)
            SvIVX(sv) = PL_cop_seqmax;
     }
 }
@@ -1135,7 +1137,8 @@ mod(OP *o, I32 type)
        if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
            break;
        yyerror(form("Can't modify %s in %s",
-                    op_desc[o->op_type],
+                    (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
+                     ? "do block" : op_desc[o->op_type]),
                     type ? op_desc[type] : "local"));
        return o;
 
@@ -1264,7 +1267,9 @@ mod(OP *o, I32 type)
        break;
 
     case OP_NULL:
-       if (!(o->op_flags & OPf_KIDS))
+       if (o->op_flags & OPf_SPECIAL)          /* do BLOCK */
+           goto nomod;
+       else if (!(o->op_flags & OPf_KIDS))
            break;
        if (o->op_targ != OP_LIST) {
            mod(cBINOPo->op_first, type);
@@ -1577,7 +1582,7 @@ block_start(int full)
     PL_pad_reset_pending = FALSE;
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVEPPTR(compiling.cop_warnings); 
+    SAVEPPTR(PL_compiling.cop_warnings); 
     if (PL_compiling.cop_warnings != WARN_ALL && 
        PL_compiling.cop_warnings != WARN_NONE) {
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
@@ -1596,7 +1601,7 @@ block_end(I32 floor, OP *seq)
     OP* retval = scalarseq(seq);
     LEAVE_SCOPE(floor);
     PL_pad_reset_pending = FALSE;
-    compiling.op_private = PL_hints;
+    PL_compiling.op_private = PL_hints;
     if (needblockscope)
        PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
     pad_leavemy(PL_comppad_name_fill);
@@ -2156,8 +2161,17 @@ pmtrans(OP *o, OP *expr, OP *repl)
        }
        else if (!rlen && !del) {
            r = t; rlen = tlen; rend = tend;
-           if (!squash && to_utf && from_utf)
-               o->op_private |= OPpTRANS_COUNTONLY;
+       }
+       if (!squash) {
+           if (to_utf && from_utf) {   /* only counting characters */
+               if (t == r || (tlen == rlen && memEQ(t, r, tlen)))
+                   o->op_private |= OPpTRANS_IDENTICAL;
+           }
+           else {      /* straight latin-1 translation */
+               if (tlen == 4 && memEQ(t, "\0\377\303\277", 4) &&
+                   rlen == 4 && memEQ(r, "\0\377\303\277", 4))
+                   o->op_private |= OPpTRANS_IDENTICAL;
+           }
        }
 
        while (t < tend || tfirst <= tlast) {
@@ -2286,7 +2300,7 @@ pmtrans(OP *o, OP *expr, OP *repl)
        if (!rlen && !del) {
            r = t; rlen = tlen;
            if (!squash)
-               o->op_private |= OPpTRANS_COUNTONLY;
+               o->op_private |= OPpTRANS_IDENTICAL;
        }
        for (i = 0; i < 256; i++)
            tbl[i] = -1;
@@ -2568,6 +2582,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
     OP *rqop;
     OP *imop;
     OP *veop;
+    GV *gv;
 
     if (id->op_type != OP_CONST)
        croak("Module name must be constant");
@@ -2619,8 +2634,21 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
                        newUNOP(OP_METHOD, 0, meth)));
     }
 
-    /* Fake up a require */
-    rqop = newUNOP(OP_REQUIRE, 0, id);
+    /* Fake up a require, handle override, if any */
+    gv = gv_fetchpv("require", FALSE, SVt_PVCV);
+    if (!(gv && GvIMPORTED_CV(gv)))
+       gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
+
+    if (gv && GvIMPORTED_CV(gv)) {
+       rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+                              append_elem(OP_LIST, id,
+                                          scalar(newUNOP(OP_RV2CV, 0,
+                                                         newGVOP(OP_GV, 0,
+                                                                 gv))))));
+    }
+    else {
+       rqop = newUNOP(OP_REQUIRE, 0, id);
+    }
 
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newSUB(floor,
@@ -2637,6 +2665,29 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
 }
 
 OP *
+dofile(OP *term)
+{
+    OP *doop;
+    GV *gv;
+
+    gv = gv_fetchpv("do", FALSE, SVt_PVCV);
+    if (!(gv && GvIMPORTED_CV(gv)))
+       gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
+
+    if (gv && GvIMPORTED_CV(gv)) {
+       doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+                              append_elem(OP_LIST, term,
+                                          scalar(newUNOP(OP_RV2CV, 0,
+                                                         newGVOP(OP_GV, 0,
+                                                                 gv))))));
+    }
+    else {
+       doop = newUNOP(OP_DOFILE, 0, scalar(term));
+    }
+    return doop;
+}
+
+OP *
 newSLICEOP(I32 flags, OP *subscript, OP *listval)
 {
     return newBINOP(OP_LSLICE, flags,
@@ -2836,7 +2887,7 @@ newSTATEOP(I32 flags, char *label, OP *o)
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
-    compiling.op_private = cop->op_private;
+    PL_compiling.op_private = cop->op_private;
     cop->op_next = (OP*)cop;
 
     if (label) {
@@ -2887,7 +2938,7 @@ intro_my(void)
     svp = AvARRAY(PL_comppad_name);
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
        if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
-           SvIVX(sv) = 999999999;      /* Don't know scope end yet. */
+           SvIVX(sv) = PAD_MAX;        /* Don't know scope end yet. */
            SvNVX(sv) = (double)PL_cop_seqmax;
        }
     }
@@ -4010,6 +4061,7 @@ newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
            if (!PL_initav)
                PL_initav = newAV();
            av_push(PL_initav, (SV *)cv);
+           GvCV(gv) = 0;
        }
     }
     else
@@ -4686,6 +4738,8 @@ ck_index(OP *o)
 {
     if (o->op_flags & OPf_KIDS) {
        OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
+       if (kid)
+           kid = kid->op_sibling;                      /* get past "big" */
        if (kid && kid->op_type == OP_CONST)
            fbm_compile(((SVOP*)kid)->op_sv, 0);
     }