X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=9aea6c4190540710357e88dad3a166824a25fb8e;hb=d2be0de5a5030be3ee411cadf9db630bb6fd8a4a;hp=043f0be6c0637a5c03a662a08f8b4af1d29ed954;hpb=6d822dc4045278fb03135b2683bac92dba061369;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 043f0be..9aea6c4 100644
--- 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 */