patch based on:

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

diff --git a/op.c b/op.c
index 043f0be..9aea6c4 100644 (file)
--- a/op.c
+++ b/op.c
@@ -610,7 +610,12 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
        SvPADTMP_off(PL_curpad[po]);
 #ifdef USE_ITHREADS
-       SvREADONLY_off(PL_curpad[po]);  /* could be a freed constant */
+#ifdef PERL_COPY_ON_WRITE
+       if (SvIsCOW(PL_curpad[po])) {
+           sv_force_normal_flags(PL_curpad[po], SV_COW_DROP_PV);
+       } else
+#endif
+           SvREADONLY_off(PL_curpad[po]);      /* could be a freed constant */
 #endif
     }
     if ((I32)po < PL_padix)
@@ -2141,10 +2146,16 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
     OP *rops = Nullop;
     int maybe_scalar = 0;
 
+/* [perl #17376]: this appears to be premature, and results in code such as
+   C< my(%x); > executing in list mode rather than void mode */
+#if 0
     if (o->op_flags & OPf_PARENS)
        list(o);
     else
        maybe_scalar = 1;
+#else
+    maybe_scalar = 1;
+#endif
     if (attrs)
        SAVEFREEOP(attrs);
     o = my_kid(o, attrs, &rops);
@@ -2376,7 +2387,13 @@ OP *
 Perl_localize(pTHX_ OP *o, I32 lex)
 {
     if (o->op_flags & OPf_PARENS)
+/* [perl #17376]: this appears to be premature, and results in code such as
+   C< our(%x); > executing in list mode rather than void mode */
+#if 0
        list(o);
+#else
+       ;
+#endif
     else {
        if (ckWARN(WARN_PARENTHESIS)
            && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
@@ -3348,24 +3365,17 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
 void
 Perl_package(pTHX_ OP *o)
 {
-    SV *sv;
+    char *name;
+    STRLEN len;
 
     save_hptr(&PL_curstash);
     save_item(PL_curstname);
-    if (o) {
-       STRLEN len;
-       char *name;
-       sv = cSVOPo->op_sv;
-       name = SvPV(sv, len);
-       PL_curstash = gv_stashpvn(name,len,TRUE);
-       sv_setpvn(PL_curstname, name, len);
-       op_free(o);
-    }
-    else {
-       deprecate("\"package\" with no arguments");
-       sv_setpv(PL_curstname,"<none>");
-       PL_curstash = Nullhv;
-    }
+
+    name = SvPV(cSVOPo->op_sv, len);
+    PL_curstash = gv_stashpvn(name, len, TRUE);
+    sv_setpvn(PL_curstname, name, len);
+    op_free(o);
+
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
@@ -3878,8 +3888,12 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        }
     }
     if (first->op_type == OP_CONST) {
-       if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
-           Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
+       if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) {
+           if (first->op_private & OPpCONST_STRICT)
+               no_bareword_allowed(first);
+           else
+               Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
+       }
        if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
            op_free(first);
            *firstp = Nullop;
@@ -4388,7 +4402,7 @@ Perl_cv_undef(pTHX_ CV *cv)
            AV *padlist = CvPADLIST(cv);
            I32 ix;
            /* pads may be cleared out already during global destruction */
-           if (is_eval && !PL_dirty) {
+           if ((is_eval && !PL_dirty) || CvSPECIAL(cv)) {
                /* inner references to eval's cv must be fixed up */
                AV *comppad_name = (AV*)AvARRAY(padlist)[0];
                AV *comppad = (AV*)AvARRAY(padlist)[1];
@@ -5217,6 +5231,9 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
                        GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
 
+    if (!subaddr)
+       Perl_croak(aTHX_ "panic: no address for '%s' in '%s'", name, filename);
+
     if ((cv = (name ? GvCV(gv) : Nullcv))) {
        if (GvCVGEN(gv)) {
            /* just a cached method */