X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7680e184ccc299509cb60f73dd84391ef26e0f56..f0ab9afb53ef594bb6fb8989153fbfba9762816f:/pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 2edbdd0..3d4992f 100644
--- 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;
@@ -279,20 +279,19 @@ PP(pp_substcont)
 	s = orig + (m - s);
 	cx->sb_strend = s + (cx->sb_strend - m);
     }
-    cx->sb_m = m = rx->startp[0] + orig;
+    cx->sb_m = m = rx->offs[0].start + orig;
     if (m > s) {
 	if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ))
 	    sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
 	else
 	    sv_catpvn(dstr, s, m-s);
     }
-    cx->sb_s = rx->endp[0] + orig;
+    cx->sb_s = rx->offs[0].end + orig;
     { /* Update the pos() information. */
 	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))
@@ -346,8 +345,8 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
     *p++ = PTR2UV(rx->subbeg);
     *p++ = (UV)rx->sublen;
     for (i = 0; i <= rx->nparens; ++i) {
-	*p++ = (UV)rx->startp[i];
-	*p++ = (UV)rx->endp[i];
+	*p++ = (UV)rx->offs[i].start;
+	*p++ = (UV)rx->offs[i].end;
     }
 }
 
@@ -374,8 +373,8 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
     rx->subbeg = INT2PTR(char*,*p++);
     rx->sublen = (I32)(*p++);
     for (i = 0; i <= rx->nparens; ++i) {
-	rx->startp[i] = (I32)(*p++);
-	rx->endp[i] = (I32)(*p++);
+	rx->offs[i].start = (I32)(*p++);
+	rx->offs[i].end = (I32)(*p++);
     }
 }
 
@@ -2658,9 +2657,8 @@ S_save_lines(pTHX_ AV *array, SV *sv)
 
     while (s && s < send) {
 	const char *t;
-	SV * const tmpstr = newSV(0);
+	SV * const tmpstr = newSV_type(SVt_PVMG);
 
-	sv_upgrade(tmpstr, SVt_PVMG);
 	t = strchr(s, '\n');
 	if (t)
 	    t++;
@@ -2887,8 +2885,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     PUSHMARK(SP);
 
     SAVESPTR(PL_compcv);
-    PL_compcv = (CV*)newSV(0);
-    sv_upgrade((SV *)PL_compcv, SVt_PVCV);
+    PL_compcv = (CV*)newSV_type(SVt_PVCV);
     CvEVAL_on(PL_compcv);
     assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
     cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
@@ -3092,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",
@@ -3104,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))
@@ -3444,6 +3452,7 @@ PP(pp_entereval)
     }
     sv = POPs;
 
+    TAINT_IF(SvTAINTED(sv));
     TAINT_PROPER("eval");
 
     ENTER;