/* 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.
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;
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;
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))
else if (PL_errors)
sv_catsv(PL_errors, err);
else
- Perl_warn(aTHX_ "%"SVf, (void*)err);
+ Perl_warn(aTHX_ "%"SVf, SVfARG(err));
++PL_error_count;
}
/* Unassume the success we assumed earlier. */
SV * const nsv = cx->blk_eval.old_namesv;
(void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
- DIE(aTHX_ "%"SVf" did not return a true value", (void*)nsv);
+ DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv));
}
break;
case CXt_FORMAT:
goto retry;
tmpstr = sv_newmortal();
gv_efullname3(tmpstr, gv, NULL);
- DIE(aTHX_ "Goto undefined subroutine &%"SVf"",(void*)tmpstr);
+ DIE(aTHX_ "Goto undefined subroutine &%"SVf"", SVfARG(tmpstr));
}
DIE(aTHX_ "Goto undefined subroutine");
}
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++;
* 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)
{
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;
}
else {
if (!*msg) {
- sv_setpv(ERRSV, "Compilation error");
+ sv_setpvs(ERRSV, "Compilation error");
}
}
PERL_UNUSED_VAR(newsp);
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",
- (void*)vnormal(sv), (void*)vnormal(PL_patchlevel));
+ SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
}
else {
if ( vcmp(sv,PL_patchlevel) > 0 )
DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
- (void*)vnormal(sv), (void*)vnormal(PL_patchlevel));
+ 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))
ENTER;
SAVETMPS;
- lex_start(sv_2mortal(newSVpvs("")));
+ lex_start(NULL);
SAVEGENERICSV(PL_rsfp_filters);
PL_rsfp_filters = NULL;
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 ;
}
sv = POPs;
+ TAINT_IF(SvTAINTED(sv));
TAINT_PROPER("eval");
ENTER;
/* Unassume the success we assumed earlier. */
SV * const nsv = cx->blk_eval.old_namesv;
(void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
- retop = Perl_die(aTHX_ "%"SVf" did not return a true value", (void*)nsv);
+ retop = Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv));
/* die_where() did LEAVE, or we won't be here */
}
else {
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)