Silence bogus typo warning on $DB::postponed
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 2776dda..db97cb6 100644 (file)
--- a/op.c
+++ b/op.c
@@ -177,9 +177,10 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
     int saweval;
 
     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
-       AV* curlist = CvPADLIST(cv);
-       SV** svp = av_fetch(curlist, 0, FALSE);
+       AV *curlist = CvPADLIST(cv);
+       SV **svp = av_fetch(curlist, 0, FALSE);
        AV *curname;
+
        if (!svp || *svp == &sv_undef)
            continue;
        curname = (AV*)*svp;
@@ -187,6 +188,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
        for (off = AvFILL(curname); off > 0; off--) {
            if ((sv = svp[off]) &&
                sv != &sv_undef &&
+               !SvFAKE(sv) &&
                seq <= SvIVX(sv) &&
                seq > I_32(SvNVX(sv)) &&
                strEQ(SvPVX(sv), name))
@@ -197,8 +199,8 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 
                depth = CvDEPTH(cv);
                if (!depth) {
-                   if (newoff && !CvUNIQUE(cv))
-                       return 0; /* don't clone inactive sub's stack frame */
+                   if (newoff)
+                       return 0; /* don't clone from inactive stack frame */
                    depth = 1;
                }
                oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
@@ -211,7 +213,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
                    av_store(comppad_name, newoff, sv);
                    SvNVX(sv) = (double)curcop->cop_seq;
                    SvIVX(sv) = 999999999;      /* A ref, intro immediately */
-                   SvFLAGS(sv) |= SVf_FAKE;
+                   SvFAKE_on(sv);              /* A ref, not a real var */
                    if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) {
                        /* "It's closures all the way down." */
                        CvCLONE_on(compcv);
@@ -404,7 +406,7 @@ pad_free(PADOFFSET po)
     if (!po)
        croak("panic: pad_free po");
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %d\n", po));
-    if (curpad[po] && curpad[po] != &sv_undef)
+    if (curpad[po] && !SvIMMORTAL(curpad[po]))
        SvPADTMP_off(curpad[po]);
     if ((I32)po < padix)
        padix = po - 1;
@@ -440,7 +442,7 @@ pad_reset()
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad reset\n"));
     if (!tainting) {   /* Can't mix tainted and non-tainted temporaries. */
        for (po = AvMAX(comppad); po > padix_floor; po--) {
-           if (curpad[po] && curpad[po] != &sv_undef)
+           if (curpad[po] && !SvIMMORTAL(curpad[po]))
                SvPADTMP_off(curpad[po]);
        }
        padix = padix_floor;
@@ -691,8 +693,6 @@ OP *op;
     case OP_AELEM:
     case OP_AELEMFAST:
     case OP_ASLICE:
-    case OP_VALUES:
-    case OP_KEYS:
     case OP_HELEM:
     case OP_HSLICE:
     case OP_UNPACK:
@@ -815,6 +815,8 @@ OP *op;
                deprecate("implicit split to @_");
        }
        break;
+    case OP_KEYS:
+    case OP_VALUES:
     case OP_DELETE:
        op->op_private |= OPpLEAVE_VOID;
        break;
@@ -1368,17 +1370,26 @@ OP *op;
        peep(eval_start);
     }
     else {
-       if (!op) {
-           main_start = 0;
+       if (!op)
            return;
-       }
        main_root = scope(sawparens(scalarvoid(op)));
        curcop = &compiling;
        main_start = LINKLIST(main_root);
        main_root->op_next = 0;
        peep(main_start);
-       main_cv = compcv;
        compcv = 0;
+
+       /* Register with debugger */
+       if (perldb) {
+           CV *cv = perl_get_cv("DB::postponed", FALSE);
+           if (cv) {
+               dSP;
+               PUSHMARK(sp);
+               XPUSHs((SV*)compiling.cop_filegv);
+               PUTBACK;
+               perl_call_sv((SV*)cv, G_DISCARD);
+           }
+       }
     }
 }
 
@@ -2366,6 +2377,9 @@ OP *op;
     }
     cop->op_flags = flags;
     cop->op_private = 0 | (flags >> 8);
+#ifdef NATIVE_HINTS
+    cop->op_private |= NATIVE_HINTS;
+#endif
     cop->op_next = (OP*)cop;
 
     if (label) {
@@ -2844,10 +2858,10 @@ CV* cv;
 {
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
-    AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
-    AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
-    SV** pname = AvARRAY(pad_name);
-    SV** ppad = AvARRAY(pad);
+    AV* pad_name;
+    AV* pad;
+    SV** pname;
+    SV** ppad;
     I32 ix;
 
     PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n",
@@ -2863,10 +2877,20 @@ CV* cv;
                   : CvUNIQUE(outside) ? "UNIQUE"
                   : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
 
+    if (!padlist)
+       return;
+
+    pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
+    pad = (AV*)*av_fetch(padlist, 1, FALSE);
+    pname = AvARRAY(pad_name);
+    ppad = AvARRAY(pad);
+
     for (ix = 1; ix <= AvFILL(pad); ix++) {
        if (SvPOK(pname[ix]))
-           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (\"%s\" %ld-%ld)\n",
-                         ix, ppad[ix], SvPVX(pname[ix]),
+           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (%s\"%s\" %ld-%ld)\n",
+                         ix, ppad[ix],
+                         SvFAKE(pname[ix]) ? "FAKE " : "",
+                         SvPVX(pname[ix]),
                          (long)I_32(SvNVX(pname[ix])),
                          (long)SvIVX(pname[ix]));
     }
@@ -2925,11 +2949,11 @@ CV* outside;
     AvFLAGS(av) = AVf_REIFY;
 
     for (ix = AvFILL(protopad); ix > 0; ix--) {
-       SV* sv;
-       if (pname[ix] != &sv_undef) {
-           char *name = SvPVX(pname[ix]);    /* XXX */
-           if (SvFLAGS(pname[ix]) & SVf_FAKE) {   /* lexical from outside? */
-               I32 off = pad_findlex(name, ix, SvIVX(pname[ix]),
+       SV* namesv = pname[ix];
+       if (namesv && namesv != &sv_undef) {
+           char *name = SvPVX(namesv);    /* XXX */
+           if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
+               I32 off = pad_findlex(name, ix, SvIVX(namesv),
                                      CvOUTSIDE(cv), cxstack_ix);
                if (!off)
                    curpad[ix] = SvREFCNT_inc(ppad[ix]);
@@ -2937,6 +2961,7 @@ CV* outside;
                    croak("panic: cv_clone: %s", name);
            }
            else {                              /* our own lexical */
+               SV* sv;
                if (*name == '&') {
                    /* anon code -- we'll come back for it */
                    sv = SvREFCNT_inc(ppad[ix]);
@@ -2953,7 +2978,7 @@ CV* outside;
            }
        }
        else {
-           sv = NEWSV(0,0);
+           SV* sv = NEWSV(0,0);
            SvPADTMP_on(sv);
            curpad[ix] = sv;
        }
@@ -2962,9 +2987,11 @@ CV* outside;
     /* Now that vars are all in place, clone nested closures. */
 
     for (ix = AvFILL(protopad); ix > 0; ix--) {
-       if (pname[ix] != &sv_undef
-           && !(SvFLAGS(pname[ix]) & SVf_FAKE)
-           && *SvPVX(pname[ix]) == '&'
+       SV* namesv = pname[ix];
+       if (namesv
+           && namesv != &sv_undef
+           && !(SvFLAGS(namesv) & SVf_FAKE)
+           && *SvPVX(namesv) == '&'
            && CvCLONE(ppad[ix]))
        {
            CV *kid = cv_clone2((CV*)ppad[ix], cv);
@@ -3051,6 +3078,11 @@ OP *block;
                        SvPOK(cv) ? SvPV((SV*)cv,na) : "none",
                        p ? p : "none");
            }
+           if (!block) {
+               /* just a "sub foo;" when &foo is already defined */
+               SAVEFREESV(compcv);
+               goto done;
+           }
            if (const_sv || dowarn) {
                line_t oldline = curcop->cop_line;
                curcop->cop_line = copline;
@@ -3138,7 +3170,7 @@ OP *block;
            gv_efullname3(tmpstr, gv, Nullch);
            hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
            if (!db_postponed) {
-               db_postponed = gv_fetchpv("DB::postponed", TRUE, SVt_PVHV);
+               db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
            }
            hv = GvHVn(db_postponed);
            if (HvFILL(hv) >= 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
@@ -3182,6 +3214,7 @@ OP *block;
        }
     }
 
+  done:
     copline = NOLINE;
     LEAVE_SCOPE(floor);
     return cv;
@@ -3779,8 +3812,8 @@ OP *op;
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
                    if (dowarn)
-                       warn("Array @%s missing the @ in argument %d of %s()",
-                           name, numargs, op_desc[type]);
+                       warn("Array @%s missing the @ in argument %ld of %s()",
+                           name, (long)numargs, op_desc[type]);
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -3797,8 +3830,8 @@ OP *op;
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
                    if (dowarn)
-                       warn("Hash %%%s missing the %% in argument %d of %s()",
-                           name, numargs, op_desc[type]);
+                       warn("Hash %%%s missing the %% in argument %ld of %s()",
+                           name, (long)numargs, op_desc[type]);
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -3880,6 +3913,8 @@ OP *op;
                                                newGVOP(OP_GV, 0, gv)))));
        return ck_subr(op);
     }
+    if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling)
+       append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
     gv = newGVgen("main");
     gv_IOadd(gv);
     append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));