change#5905 wasn't quite right--it's intent only applies when arguments

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

diff --git a/op.c b/op.c
index 95aa4f2..3275d0e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -321,9 +321,12 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                        }
                    }
                    else if (!CvUNIQUE(PL_compcv)) {
-                       if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv))
+                       if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
+                           && !(SvFLAGS(sv) & SVpad_OUR))
+                       {
                            Perl_warner(aTHX_ WARN_CLOSURE,
                                "Variable \"%s\" will not stay shared", name);
+                       }
                    }
                }
                av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
@@ -3222,8 +3225,15 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
            sv = va_arg(*args, SV*);
        }
     }
-    utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
-           veop, modname, imop);
+    {
+       line_t ocopline = PL_copline;
+       int oexpect = PL_expect;
+
+       utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+               veop, modname, imop);
+       PL_expect = oexpect;
+       PL_copline = ocopline;
+    }
 }
 
 OP *
@@ -6262,7 +6272,9 @@ Perl_ck_subr(pTHX_ OP *o)
                proto++;
                arg++;
                if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
-                   bad_type(arg, "block", gv_ename(namegv), o2);
+                   bad_type(arg,
+                       arg == 1 ? "block or sub {}" : "sub {}",
+                       gv_ename(namegv), o2);
                break;
            case '*':
                /* '*' allows any scalar type, including bareword */
@@ -6310,8 +6322,8 @@ Perl_ck_subr(pTHX_ OP *o)
                        bad_type(arg, "symbol", gv_ename(namegv), o2);
                    goto wrapref;
                case '&':
-                   if (o2->op_type != OP_RV2CV)
-                       bad_type(arg, "sub", gv_ename(namegv), o2);
+                   if (o2->op_type != OP_ENTERSUB)
+                       bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
                    goto wrapref;
                case '$':
                    if (o2->op_type != OP_RV2SV
@@ -6428,9 +6440,18 @@ Perl_peep(pTHX_ register OP *o)
             * for reference counts, sv_upgrade() etc. */
            if (cSVOP->op_sv) {
                PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
-               SvREFCNT_dec(PL_curpad[ix]);
-               SvPADTMP_on(cSVOPo->op_sv);
-               PL_curpad[ix] = cSVOPo->op_sv;
+               if (SvPADTMP(cSVOPo->op_sv)) {
+                   /* If op_sv is already a PADTMP then it is being used by
+                    * another pad, so make a copy. */
+                   sv_setsv(PL_curpad[ix],cSVOPo->op_sv);
+                   SvREADONLY_on(PL_curpad[ix]);
+                   SvREFCNT_dec(cSVOPo->op_sv);
+               }
+               else {
+                   SvREFCNT_dec(PL_curpad[ix]);
+                   SvPADTMP_on(cSVOPo->op_sv);
+                   PL_curpad[ix] = cSVOPo->op_sv;
+               }
                cSVOPo->op_sv = Nullsv;
                o->op_targ = ix;
            }