X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=f818869d59bdfe57f4bb4c67c74838a4c354b45c;hb=25ff0154ccf606eb5512a8cde622caf50e20fba3;hp=5c4639f9aa2f0767a449edb0d38b24724827b24d;hpb=be2597dfdde55c276ac6c4b68dadc448c601d0cc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 5c4639f..f818869 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,7 +1,7 @@
 /*    pp_ctl.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -177,7 +177,7 @@ PP(pp_regcomp)
 
     if (!PM_GETRE(pm)->prelen && PL_curpm)
 	pm = PL_curpm;
-    else if (strEQ("\\s+", PM_GETRE(pm)->precomp))
+    else if (PM_GETRE(pm)->extflags & RXf_WHITE)
 	pm->op_pmflags |= PMf_WHITE;
     else
 	pm->op_pmflags &= ~PMf_WHITE;
@@ -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))
@@ -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++;
@@ -2874,7 +2872,6 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
  * outside is the lexically enclosing CV (if any) that invoked us.
  */
 
-/* With USE_5005THREADS, eval_owner must be held on entry to doeval */
 STATIC OP *
 S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 {
@@ -2888,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;
@@ -2971,7 +2967,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	}
 	else {
 	    if (!*msg) {
-	        sv_setpv(ERRSV, "Compilation error");
+	        sv_setpvs(ERRSV, "Compilation error");
 	    }
 	}
 	PERL_UNUSED_VAR(newsp);
@@ -3105,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)))) >= 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))
@@ -3389,10 +3396,6 @@ PP(pp_require)
         PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
         PL_compiling.cop_warnings = pWARN_NONE ;
-    else if (PL_taint_warn) {
-        PL_compiling.cop_warnings
-	    = Perl_new_warnings_bitfield(aTHX_ NULL, WARN_TAINTstring, WARNsize);
-    }
     else
         PL_compiling.cop_warnings = pWARN_STD ;
 
@@ -3449,6 +3452,7 @@ PP(pp_entereval)
     }
     sv = POPs;
 
+    TAINT_IF(SvTAINTED(sv));
     TAINT_PROPER("eval");
 
     ENTER;
@@ -3619,7 +3623,6 @@ Perl_create_eval_scope(pTHX_ U32 flags)
 
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
     PUSHEVAL(cx, 0, 0);
-    PL_eval_root = PL_op;	/* Only needed so that goto works right. */
 
     PL_in_eval = EVAL_INEVAL;
     if (flags & G_KEEPERR)