RT #74436: [PATCH] Add -Wwrite-strings

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index ccda760..57118a4 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -216,14 +216,7 @@ PP(pp_regcomp)
            }
            else if (SvAMAGIC(tmpstr)) {
                /* make a copy to avoid extra stringifies */
-               SV* copy = newSV_type(SVt_PV);
-               sv_setpvn(copy, t, len);
-               if (SvUTF8(tmpstr))
-                   SvUTF8_on(copy);
-               else
-                   SvUTF8_off(copy);
-               sv_2mortal(copy);
-               tmpstr = copy;
+               tmpstr = newSVpvn_flags(t, len, SVs_TEMP | SvUTF8(tmpstr));
            }
 
            if (eng)
@@ -1798,11 +1791,8 @@ PP(pp_caller)
        AV * const ary = cx->blk_sub.argarray;
        const int off = AvARRAY(ary) - AvALLOC(ary);
 
-       if (!PL_dbargs) {
-           PL_dbargs = GvAV(gv_AVadd(gv_fetchpvs("DB::args", GV_ADDMULTI,
-                                                 SVt_PVAV)));
-           AvREAL_off(PL_dbargs);      /* XXX should be REIFY (see av.h) */
-       }
+       if (!PL_dbargs)
+           Perl_init_dbargs(aTHX);
 
        if (AvMAX(PL_dbargs) < AvFILLp(ary) + off)
            av_extend(PL_dbargs, AvFILLp(ary) + off);
@@ -2921,6 +2911,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     int runtime;
     CV* runcv = NULL;  /* initialise to avoid compiler warnings */
     STRLEN len;
+    bool need_catch;
 
     PERL_ARGS_ASSERT_SV_COMPILE_2OP;
 
@@ -2972,11 +2963,14 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     PL_op->op_flags = 0;                       /* Avoid uninit warning. */
     PUSHBLOCK(cx, CXt_EVAL|(IN_PERL_COMPILETIME ? 0 : CXp_REAL), SP);
     PUSHEVAL(cx, 0);
+    need_catch = CATCH_GET;
+    CATCH_SET(TRUE);
 
     if (runtime)
        (void) doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
     else
        (void) doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax);
+    CATCH_SET(need_catch);
     POPBLOCK(cx,PL_curpm);
     POPEVAL(cx);
 
@@ -3138,6 +3132,8 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     else
        CLEAR_ERRSV();
 
+    CALL_BLOCK_HOOKS(eval, saveop);
+
     /* note that yyparse() may raise an exception, e.g. C<BEGIN{die}>,
      * so honour CATCH_GET and trap it here if necessary */
 
@@ -3372,21 +3368,20 @@ PP(pp_require)
        }
 
        /* We do this only with "use", not "require" or "no". */
-       if (PL_compcv &&
-               !(cUNOP->op_first->op_private & OPpCONST_NOVER) &&
-         /* If we request a version >= 5.9.5, load feature.pm with the
-          * feature bundle that corresponds to the required version. */
-               vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
-           SV *const importsv = vnormal(sv);
-           *SvPVX_mutable(importsv) = ':';
-           ENTER_with_name("load_feature");
-           Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
-           LEAVE_with_name("load_feature");
-       }
-       /* If a version >= 5.11.0 is requested, strictures are on by default! */
-       if (PL_compcv &&
-               vcmp(sv, sv_2mortal(upg_version(newSVnv(5.011000), FALSE))) >= 0) {
-           PL_hints |= (HINT_STRICT_REFS | HINT_STRICT_SUBS | HINT_STRICT_VARS);
+       if (PL_compcv && !(cUNOP->op_first->op_private & OPpCONST_NOVER)) {
+           /* If we request a version >= 5.9.5, load feature.pm with the
+            * feature bundle that corresponds to the required version. */
+           if (vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
+               SV *const importsv = vnormal(sv);
+               *SvPVX_mutable(importsv) = ':';
+               ENTER_with_name("load_feature");
+               Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
+               LEAVE_with_name("load_feature");
+           }
+           /* If a version >= 5.11.0 is requested, strictures are on by default! */
+           if (vcmp(sv, sv_2mortal(upg_version(newSVnv(5.011000), FALSE))) >= 0) {
+               PL_hints |= (HINT_STRICT_REFS | HINT_STRICT_SUBS | HINT_STRICT_VARS);
+           }
        }
 
        RETPUSHYES;
@@ -3777,10 +3772,10 @@ PP(pp_entereval)
        /* make sure we've got a plain PV (no overload etc) before testing
         * for taint. Making a copy here is probably overkill, but better
         * safe than sorry */
-       SV* tmpsv = newSV_type(SVt_PV);
-       sv_copypv(tmpsv, sv);
-       sv_2mortal(tmpsv);
-       sv = tmpsv;
+       STRLEN len;
+       const char * const p = SvPV_const(sv, len);
+
+       sv = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv));
     }
 
     TAINT_IF(SvTAINTED(sv));