Re: [perl #32687] Encode::is_utf8 on tainted UTF8 string

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 3aecb2d..124a40f 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -118,9 +118,9 @@ PP(pp_regcomp)
            mg = mg_find(sv, PERL_MAGIC_qr);
     }
     if (mg) {
-       regexp * const re = (regexp *)mg->mg_obj;
+       regexp * const re = reg_temp_copy((regexp *)mg->mg_obj);
        ReREFCNT_dec(PM_GETRE(pm));
-       PM_SETRE(pm, ReREFCNT_inc(re));
+       PM_SETRE(pm, re);
     }
     else {
        STRLEN len;
@@ -291,8 +291,7 @@ PP(pp_substcont)
        SV * const sv = cx->sb_targ;
        MAGIC *mg;
        I32 i;
-       if (SvTYPE(sv) < SVt_PVMG)
-           SvUPGRADE(sv, SVt_PVMG);
+       SvUPGRADE(sv, SVt_PVMG);
        if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
 #ifdef PERL_OLD_COPY_ON_WRITE
            if (SvIsCOW(sv))
@@ -3090,7 +3089,7 @@ PP(pp_require)
 
        sv = new_version(sv);
        if (!sv_derived_from(PL_patchlevel, "version"))
-           upg_version(PL_patchlevel);
+           upg_version(PL_patchlevel, TRUE);
        if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
            if ( vcmp(sv,PL_patchlevel) <= 0 )
                DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped",
@@ -3102,7 +3101,18 @@ PP(pp_require)
                    SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
        }
 
-           RETPUSHYES;
+       /* If we request a version >= 5.9.5, load feature.pm with the
+        * feature bundle that corresponds to the required version.
+        * We do this only with use, not require. */
+       if (PL_compcv && vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
+           SV *const importsv = vnormal(sv);
+           *SvPVX_mutable(importsv) = ':';
+           ENTER;
+           Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
+           LEAVE;
+       }
+
+       RETPUSHYES;
     }
     name = SvPV_const(sv, len);
     if (!(name && len > 0 && *name))