*.pod changes based on the FAQ
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 3e3df86..2784a54 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,6 +1,6 @@
 /*    op.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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;
@@ -197,22 +198,25 @@ 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) {
+                       if (SvFAKE(sv))
+                           continue;
+                       return 0; /* don't clone from inactive stack frame */
+                   }
                    depth = 1;
                }
                oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
                oldsv = *av_fetch(oldpad, off, TRUE);
                if (!newoff) {          /* Not a mere clone operation. */
-                   SV *sv = NEWSV(1103,0);
+                   SV *namesv = NEWSV(1103,0);
                    newoff = pad_alloc(OP_PADSV, SVs_PADMY);
-                   sv_upgrade(sv, SVt_PVNV);
-                   sv_setpv(sv, name);
-                   av_store(comppad_name, newoff, sv);
-                   SvNVX(sv) = (double)curcop->cop_seq;
-                   SvIVX(sv) = 999999999;      /* A ref, intro immediately */
-                   SvFLAGS(sv) |= SVf_FAKE;
-                   if (CvANON(compcv)) {
+                   sv_upgrade(namesv, SVt_PVNV);
+                   sv_setpv(namesv, name);
+                   av_store(comppad_name, newoff, namesv);
+                   SvNVX(namesv) = (double)curcop->cop_seq;
+                   SvIVX(namesv) = 999999999;  /* A ref, intro immediately */
+                   SvFAKE_on(namesv);          /* A ref, not a real var */
+                   if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) {
                        /* "It's closures all the way down." */
                        CvCLONE_on(compcv);
                        if (cv != startcv) {
@@ -223,17 +227,18 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
                                if (CvANON(bcv))
                                    CvCLONE_on(bcv);
                                else {
-                                   if (dowarn)
-                                       warn("Value of %s may be unavailable",
+                                   if (dowarn && !CvUNIQUE(cv))
+                                       warn(
+                                         "Variable \"%s\" may be unavailable",
                                             name);
                                    break;
                                }
                            }
                        }
                    }
-                   else {
-                       if (dowarn && !CvUNIQUE(cv))
-                           warn("Value of %s will not stay shared", name);
+                   else if (!CvUNIQUE(compcv)) {
+                       if (dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
+                           warn("Variable \"%s\" will not stay shared", name);
                    }
                }
                av_store(comppad, newoff, SvREFCNT_inc(oldsv));
@@ -258,10 +263,14 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
            }
            break;
        case CXt_EVAL:
-           if (cx->blk_eval.old_op_type != OP_ENTEREVAL &&
-               cx->blk_eval.old_op_type != OP_ENTERTRY)
-               return 0;       /* require must have its own scope */
-           saweval = i;
+           switch (cx->blk_eval.old_op_type) {
+           case OP_ENTEREVAL:
+               saweval = i;
+               break;
+           case OP_REQUIRE:
+               /* require must have its own scope */
+               return 0;
+           }
            break;
        case CXt_SUB:
            if (!saweval)
@@ -380,7 +389,7 @@ pad_sv(PADOFFSET po)
 {
     if (!po)
        croak("panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %d\n", po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %lu\n", (unsigned long)po));
     return curpad[po];         /* eventually we'll turn this into a macro */
 }
 
@@ -398,8 +407,8 @@ pad_free(PADOFFSET po)
        croak("panic: pad_free curpad");
     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)
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %lu\n", (unsigned long)po));
+    if (curpad[po] && !SvIMMORTAL(curpad[po]))
        SvPADTMP_off(curpad[po]);
     if ((I32)po < padix)
        padix = po - 1;
@@ -417,7 +426,7 @@ pad_swipe(PADOFFSET po)
        croak("panic: pad_swipe curpad");
     if (!po)
        croak("panic: pad_swipe po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %d\n", po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %lu\n", (unsigned long)po));
     SvPADTMP_off(curpad[po]);
     curpad[po] = NEWSV(1107,0);
     SvPADTMP_on(curpad[po]);
@@ -435,7 +444,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;
@@ -686,8 +695,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:
@@ -810,6 +817,8 @@ OP *op;
                deprecate("implicit split to @_");
        }
        break;
+    case OP_KEYS:
+    case OP_VALUES:
     case OP_DELETE:
        op->op_private |= OPpLEAVE_VOID;
        break;
@@ -1255,6 +1264,20 @@ OP *right;
 {
     OP *op;
 
+    if (dowarn &&
+       (left->op_type == OP_RV2AV ||
+        left->op_type == OP_RV2HV ||
+        left->op_type == OP_PADAV ||
+        left->op_type == OP_PADHV)) {
+       char *desc = op_desc[(right->op_type == OP_SUBST ||
+                             right->op_type == OP_TRANS)
+                            ? right->op_type : OP_MATCH];
+       char *sample = ((left->op_type == OP_RV2AV ||
+                        left->op_type == OP_PADAV)
+                       ? "@array" : "%hash");
+       warn("Applying %s to %s will act on scalar(%s)", desc, sample, sample);
+    }
+
     if (right->op_type == OP_MATCH ||
        right->op_type == OP_SUBST ||
        right->op_type == OP_TRANS) {
@@ -1363,17 +1386,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);
+           }
+       }
     }
 }
 
@@ -2361,6 +2393,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) {
@@ -2376,7 +2411,7 @@ OP *op;
         cop->cop_line = copline;
         copline = NOLINE;
     }
-    cop->cop_filegv = GvREFCNT_inc(curcop->cop_filegv);
+    cop->cop_filegv = (GV*)SvREFCNT_inc(curcop->cop_filegv);
     cop->cop_stash = curstash;
 
     if (perldb && curstash != debstash) {
@@ -2632,8 +2667,10 @@ OP *block;
     if (expr) {
        if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
            return block;       /* do {} while 0 does once */
-       else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
-           expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
+       if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) {
+           expr = newUNOP(OP_DEFINED, 0,
+               newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+       }
     }
 
     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
@@ -2810,6 +2847,7 @@ CV *cv;
        CvROOT(cv) = Nullop;
        LEAVE;
     }
+    CvFLAGS(cv) = 0;
     SvREFCNT_dec(CvGV(cv));
     CvGV(cv) = Nullgv;
     SvREFCNT_dec(CvOUTSIDE(cv));
@@ -2836,10 +2874,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",
@@ -2847,18 +2885,28 @@ CV* cv;
                  (CvANON(cv) ? "ANON"
                   : (cv == main_cv) ? "MAIN"
                   : CvUNIQUE(outside) ? "UNIQUE"
-                  : CvGV(cv) ? GvNAME(CvGV(cv)) : "?mystery?"),
+                  : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
                  outside,
                  (!outside ? "null"
                   : CvANON(outside) ? "ANON"
                   : (outside == main_cv) ? "MAIN"
                   : CvUNIQUE(outside) ? "UNIQUE"
-                  : CvGV(outside) ? GvNAME(CvGV(outside)) : "?mystery?"));
+                  : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
 
-    for (ix = 1; ix <= AvFILL(pad); ix++) {
+    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_name); 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]));
     }
@@ -2877,6 +2925,8 @@ CV* outside;
     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
     SV** pname = AvARRAY(protopad_name);
     SV** ppad = AvARRAY(protopad);
+    I32 fname = AvFILL(protopad_name);
+    I32 fpad = AvFILL(protopad);
     AV* comppadlist;
     CV* cv;
 
@@ -2888,13 +2938,13 @@ CV* outside;
     SAVESPTR(compcv);
 
     cv = compcv = (CV*)NEWSV(1104,0);
-    sv_upgrade((SV *)cv, SVt_PVCV);
+    sv_upgrade((SV *)cv, SvTYPE(proto));
     CvCLONED_on(cv);
     if (CvANON(proto))
        CvANON_on(cv);
 
     CvFILEGV(cv)       = CvFILEGV(proto);
-    CvGV(cv)           = GvREFCNT_inc(CvGV(proto));
+    CvGV(cv)           = (GV*)SvREFCNT_inc(CvGV(proto));
     CvSTASH(cv)                = CvSTASH(proto);
     CvROOT(cv)         = CvROOT(proto);
     CvSTART(cv)                = CvSTART(proto);
@@ -2916,12 +2966,12 @@ CV* outside;
     av_store(comppad, 0, (SV*)av);
     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]),
+    for (ix = fpad; ix > 0; ix--) {
+       SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
+       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]);
@@ -2929,6 +2979,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]);
@@ -2945,7 +2996,7 @@ CV* outside;
            }
        }
        else {
-           sv = NEWSV(0,0);
+           SV* sv = NEWSV(0,0);
            SvPADTMP_on(sv);
            curpad[ix] = sv;
        }
@@ -2953,10 +3004,12 @@ 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]) == '&'
+    for (ix = fpad; ix > 0; ix--) {
+       SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
+       if (namesv
+           && namesv != &sv_undef
+           && !(SvFLAGS(namesv) & SVf_FAKE)
+           && *SvPVX(namesv) == '&'
            && CvCLONE(ppad[ix]))
        {
            CV *kid = cv_clone2((CV*)ppad[ix], cv);
@@ -3018,17 +3071,15 @@ OP *op;
 OP *proto;
 OP *block;
 {
+    char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch;
+    GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
-    char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
-    GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
-    AV* av;
+    AV *av;
     I32 ix;
 
-    if (op) {
+    if (op)
        SAVEFREEOP(op);
-       sub_generation++;
-    }
-    if (cv = GvCV(gv)) {
+    if (cv = (name ? GvCV(gv) : Nullcv)) {
        if (GvCVGEN(gv)) {
            /* just a cached method */
            SvREFCNT_dec(cv);
@@ -3045,9 +3096,13 @@ OP *block;
                        SvPOK(cv) ? SvPV((SV*)cv,na) : "none",
                        p ? p : "none");
            }
-           if ((const_sv || dowarn) && strNE(name, "BEGIN")) {
+           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;
                warn(const_sv ? "Constant subroutine %s redefined"
                              : "Subroutine %s redefined",name);
@@ -3059,7 +3114,7 @@ OP *block;
     }
     if (cv) {                          /* must reuse cv if autoloaded */
        cv_undef(cv);
-       CvFLAGS(cv) = (CvFLAGS(cv)&~CVf_CLONE) | (CvFLAGS(compcv)&CVf_CLONE);
+       CvFLAGS(cv) = CvFLAGS(compcv);
        CvOUTSIDE(cv) = CvOUTSIDE(compcv);
        CvOUTSIDE(compcv) = 0;
        CvPADLIST(cv) = CvPADLIST(compcv);
@@ -3070,11 +3125,14 @@ OP *block;
     }
     else {
        cv = compcv;
+       if (name) {
+           GvCV(gv) = cv;
+           GvCVGEN(gv) = 0;
+           sub_generation++;
+       }
     }
-    GvCV(gv) = cv;
-    GvCVGEN(gv) = 0;
+    CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = curcop->cop_filegv;
-    CvGV(cv) = GvREFCNT_inc(gv);
     CvSTASH(cv) = curstash;
 
     if (proto) {
@@ -3088,7 +3146,6 @@ OP *block;
        block = Nullop;
     }
     if (!block) {
-       CvROOT(cv) = 0;
        copline = NOLINE;
        LEAVE_SCOPE(floor);
        return cv;
@@ -3100,7 +3157,7 @@ OP *block;
     AvFLAGS(av) = AVf_REIFY;
 
     for (ix = AvFILL(comppad); ix > 0; ix--) {
-       if (!SvPADMY(curpad[ix]))
+       if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
            SvPADTMP_on(curpad[ix]);
     }
 
@@ -3112,13 +3169,44 @@ OP *block;
     CvROOT(cv)->op_next = 0;
     peep(CvSTART(cv));
 
-    if (op) {
-       char *s = strrchr(name,':');
-       if (s)
+    if (name) {
+       char *s;
+
+       if (perldb && curstash != debstash) {
+           SV *sv;
+           SV *tmpstr = sv_newmortal();
+           static GV *db_postponed;
+           CV *cv;
+           HV *hv;
+
+           sprintf(buf, "%s:%ld",
+                   SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
+           sv = newSVpv(buf,0);
+           sv_catpv(sv,"-");
+           sprintf(buf,"%ld",(long)curcop->cop_line);
+           sv_catpv(sv,buf);
+           gv_efullname3(tmpstr, gv, Nullch);
+           hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+           if (!db_postponed) {
+               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))
+                 && (cv = GvCV(db_postponed))) {
+               dSP;
+               PUSHMARK(sp);
+               XPUSHs(tmpstr);
+               PUTBACK;
+               perl_call_sv((SV*)cv, G_DISCARD);
+           }
+       }
+
+       if ((s = strrchr(name,':')))
            s++;
        else
            s = name;
        if (strEQ(s, "BEGIN") && !error_count) {
+           I32 oldscope = scopestack_ix;
            ENTER;
            SAVESPTR(compiling.cop_filegv);
            SAVEI16(compiling.cop_line);
@@ -3131,7 +3219,7 @@ OP *block;
            DEBUG_x( dump_sub(gv) );
            av_push(beginav, (SV *)cv);
            GvCV(gv) = 0;
-           calllist(beginav);
+           calllist(oldscope, beginav);
 
            curcop = &compiling;
            LEAVE;
@@ -3145,37 +3233,7 @@ OP *block;
        }
     }
 
-    if (perldb && curstash != debstash) {
-       SV *sv;
-       SV *tmpstr = sv_newmortal();
-       static GV *db_postponed;
-       CV *cv;
-       HV *hv;
-
-       sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
-       sv = newSVpv(buf,0);
-       sv_catpv(sv,"-");
-       sprintf(buf,"%ld",(long)curcop->cop_line);
-       sv_catpv(sv,buf);
-       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);
-       }
-       hv = GvHVn(db_postponed);
-       if (HvFILL(hv) >= 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
-           && (cv = GvCV(db_postponed))) {
-           dSP;
-           PUSHMARK(sp);
-           XPUSHs(tmpstr);
-           PUTBACK;
-           perl_call_sv((SV*)cv, G_DISCARD);
-       }
-    }
-
-    if (!op)
-       GvCV(gv) = 0;   /* Will remember in SVOP instead. */
-
+  done:
     copline = NOLINE;
     LEAVE_SCOPE(floor);
     return cv;
@@ -3202,18 +3260,19 @@ char *name;
 void (*subaddr) _((CV*));
 char *filename;
 {
+    GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
-    GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
-
-    if (name)
-       sub_generation++;
-    if (cv = GvCV(gv)) {
-       if (GvCVGEN(gv))
-           cv = 0;                     /* just a cached method */
-       else if (CvROOT(cv) || CvXSUB(cv)) {    /* already defined? */
+
+    if (cv = (name ? GvCV(gv) : Nullcv)) {
+       if (GvCVGEN(gv)) {
+           /* just a cached method */
+           SvREFCNT_dec(cv);
+           cv = 0;
+       }
+       else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
+           /* already defined (or promised) */
            if (dowarn) {
                line_t oldline = curcop->cop_line;
-
                curcop->cop_line = copline;
                warn("Subroutine %s redefined",name);
                curcop->cop_line = oldline;
@@ -3222,19 +3281,22 @@ char *filename;
            cv = 0;
        }
     }
-    if (cv) {                          /* must reuse cv if autoloaded */
-       assert(SvREFCNT(CvGV(cv)) > 1);
-       SvREFCNT_dec(CvGV(cv));
-    }
+
+    if (cv)                            /* must reuse cv if autoloaded */
+       cv_undef(cv);
     else {
        cv = (CV*)NEWSV(1105,0);
        sv_upgrade((SV *)cv, SVt_PVCV);
+       if (name) {
+           GvCV(gv) = cv;
+           GvCVGEN(gv) = 0;
+           sub_generation++;
+       }
     }
-    GvCV(gv) = cv;
-    CvGV(cv) = GvREFCNT_inc(gv);
-    GvCVGEN(gv) = 0;
+    CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = gv_fetchfile(filename);
     CvXSUB(cv) = subaddr;
+
     if (name) {
        char *s = strrchr(name,':');
        if (s)
@@ -3244,19 +3306,20 @@ char *filename;
        if (strEQ(s, "BEGIN")) {
            if (!beginav)
                beginav = newAV();
-           av_push(beginav, SvREFCNT_inc(gv));
+           av_push(beginav, (SV *)cv);
+           GvCV(gv) = 0;
        }
        else if (strEQ(s, "END")) {
            if (!endav)
                endav = newAV();
            av_unshift(endav, 1);
-           av_store(endav, 0, SvREFCNT_inc(gv));
+           av_store(endav, 0, (SV *)cv);
+           GvCV(gv) = 0;
        }
     }
-    else {
-       GvCV(gv) = 0;   /* Will remember elsewhere instead. */
+    else
        CvANON_on(cv);
-    }
+
     return cv;
 }
 
@@ -3289,11 +3352,11 @@ OP *block;
     }
     cv = compcv;
     GvFORM(gv) = cv;
-    CvGV(cv) = GvREFCNT_inc(gv);
+    CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = curcop->cop_filegv;
 
     for (ix = AvFILL(comppad); ix > 0; ix--) {
-       if (!SvPADMY(curpad[ix]))
+       if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
            SvPADTMP_on(curpad[ix]);
     }
 
@@ -3301,7 +3364,6 @@ OP *block;
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
     peep(CvSTART(cv));
-    FmLINES(cv) = 0;
     op_free(op);
     copline = NOLINE;
     LEAVE_SCOPE(floor);
@@ -3635,9 +3697,31 @@ register OP *op;
 
     op->op_private |= (hints & HINT_STRICT_REFS);
     if (kid->op_type == OP_CONST) {
-       int iscv = (op->op_type==OP_RV2CV)*2;
-       GV *gv = 0;
+       char *name;
+       int iscv;
+       GV *gv;
+
+       name = SvPV(kid->op_sv, na);
+       if ((hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
+           char *badthing = Nullch;
+           switch (op->op_type) {
+           case OP_RV2SV:
+               badthing = "a SCALAR";
+               break;
+           case OP_RV2AV:
+               badthing = "an ARRAY";
+               break;
+           case OP_RV2HV:
+               badthing = "a HASH";
+               break;
+           }
+           if (badthing)
+               croak(
+         "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
+                     name, badthing);
+       }
        kid->op_type = OP_GV;
+       iscv = (op->op_type == OP_RV2CV) * 2;
        for (gv = 0; !gv; iscv++) {
            /*
             * This is a little tricky.  We only want to add the symbol if we
@@ -3647,7 +3731,7 @@ register OP *op;
             * or we get possible typo warnings.  OPpCONST_ENTERED says
             * whether the lexer already added THIS instance of this symbol.
             */
-           gv = gv_fetchpv(SvPVx(kid->op_sv, na),
+           gv = gv_fetchpv(name,
                iscv | !(kid->op_private & OPpCONST_ENTERED),
                iscv
                    ? SVt_PVCV
@@ -3747,8 +3831,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;
@@ -3765,8 +3849,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;
@@ -3848,6 +3932,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));
@@ -4328,7 +4414,6 @@ OP *op;
        }
        else
            list(o);
-       mod(o, OP_ENTERSUB);
        prev = o;
        o = o->op_sibling;
     }