op.c:ck_svconst: Don’t allow ro COWs under old COW

[perl5.git] / op.c

diff --git a/op.c b/op.c
index e308d08..a209110 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1790,7 +1790,7 @@ S_finalize_op(pTHX_ OP* o)
        /* Make the CONST have a shared SV */
        svp = cSVOPx_svp(((BINOP*)o)->op_last);
        if ((!SvIsCOW(sv = *svp))
-           && SvTYPE(sv) < SVt_PVMG && !SvROK(sv)) {
+           && SvTYPE(sv) < SVt_PVMG && SvOK(sv) && !SvROK(sv)) {
            key = SvPV_const(sv, keylen);
            lexname = newSVpvn_share(key,
                SvUTF8(sv) ? -(I32)keylen : (I32)keylen,
@@ -3275,6 +3275,7 @@ S_fold_constants(pTHX_ OP *o)
     /* Verify that we don't need to save it:  */
     assert(PL_curcop == &PL_compiling);
     StructCopy(&PL_compiling, &not_compiling, COP);
+    CopHINTS_set(&not_compiling, PL_hints);
     PL_curcop = &not_compiling;
     /* The above ensures that we run with all the correct hints of the
        currently compiling COP, but that IN_PERL_RUNTIME is not true. */
@@ -3333,7 +3334,8 @@ S_fold_constants(pTHX_ OP *o)
     op_free(o);
 #endif
     assert(sv);
-    if (!SvIMMORTAL(sv)) SvPADTMP_on(sv);
+    if (type == OP_STRINGIFY) SvPADTMP_off(sv);
+    else if (!SvIMMORTAL(sv)) SvPADTMP_on(sv);
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
     else
@@ -4919,7 +4921,7 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
     return CHECKOP(type, padop);
 }
 
-#endif /* !USE_ITHREADS */
+#endif /* USE_ITHREADS */
 
 /*
 =for apidoc Am|OP *|newGVOP|I32 type|I32 flags|GV *gv
@@ -5418,24 +5420,20 @@ S_aassign_common_vars(pTHX_ OP* o)
                    return TRUE;
            }
            else if (curop->op_type == OP_PUSHRE) {
+               GV *const gv =
 #ifdef USE_ITHREADS
-               if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
-                   GV *const gv = MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff));
-                   if (gv == PL_defgv
-                       || (int)GvASSIGN_GENERATION(gv) == PL_generation)
-                       return TRUE;
-                   GvASSIGN_GENERATION_set(gv, PL_generation);
-               }
+                   ((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff
+                       ? MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff))
+                       : NULL;
 #else
-               GV *const gv
-                   = ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
+                   ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
+#endif
                if (gv) {
                    if (gv == PL_defgv
                        || (int)GvASSIGN_GENERATION(gv) == PL_generation)
                        return TRUE;
                    GvASSIGN_GENERATION_set(gv, PL_generation);
                }
-#endif
            }
            else
                return TRUE;
@@ -7779,12 +7777,7 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len,
 {
     dVAR;
     CV* cv;
-#ifdef USE_ITHREADS
     const char *const file = CopFILE(PL_curcop);
-#else
-    SV *const temp_sv = CopFILESV(PL_curcop);
-    const char *const file = temp_sv ? SvPV_nolen_const(temp_sv) : NULL;
-#endif
 
     ENTER;
 
@@ -7918,13 +7911,19 @@ CV *
 Perl_newSTUB(pTHX_ GV *gv, bool fake)
 {
     CV *cv = MUTABLE_CV(newSV_type(SVt_PVCV));
+    GV *cvgv;
     PERL_ARGS_ASSERT_NEWSTUB;
     assert(!GvCVu(gv));
     GvCV_set(gv, cv);
     GvCVGEN(gv) = 0;
     if (!fake && HvENAME_HEK(GvSTASH(gv)))
        gv_method_changed(gv);
-    CvGV_set(cv, gv);
+    if (SvFAKE(gv)) {
+       cvgv = gv_fetchsv((SV *)gv, GV_ADDMULTI, SVt_PVCV);
+       SvFAKE_off(cvgv);
+    }
+    else cvgv = gv;
+    CvGV_set(cv, cvgv);
     CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH_set(cv, PL_curstash);
     GvMULTI_on(gv);
@@ -8374,12 +8373,9 @@ Perl_ck_eval(pTHX_ OP *o)
     PL_hints |= HINT_BLOCK_SCOPE;
     if (o->op_flags & OPf_KIDS) {
        SVOP * const kid = (SVOP*)cUNOPo->op_first;
+       assert(kid);
 
-       if (!kid) {
-           o->op_flags &= ~OPf_KIDS;
-           op_null(o);
-       }
-       else if (kid->op_type == OP_LINESEQ || kid->op_type == OP_STUB) {
+       if (kid->op_type == OP_LINESEQ || kid->op_type == OP_STUB) {
            LOGOP *enter;
 #ifdef PERL_MAD
            OP* const oldo = o;
@@ -10562,6 +10558,9 @@ Perl_ck_svconst(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_SVCONST;
     PERL_UNUSED_CONTEXT;
+#ifdef PERL_OLD_COPY_ON_WRITE
+    if (SvIsCOW(cSVOPo->op_sv)) sv_force_normal(cSVOPo->op_sv);
+#endif
     SvREADONLY_on(cSVOPo->op_sv);
     return o;
 }