/* XXXX Should store the old value to allow for tie/overload - and
restore in regcomp, where marked with XXXX. */
PL_reginterp_cnt = 0;
+ TAINT_NOT;
return NORMAL;
}
char *orig = cx->sb_orig;
register REGEXP *rx = cx->sb_rx;
SV *nsv = Nullsv;
-
- {
- REGEXP *old = PM_GETRE(pm);
- if(old != rx) {
+ REGEXP *old = PM_GETRE(pm);
+ if(old != rx) {
if(old)
- ReREFCNT_dec(old);
+ ReREFCNT_dec(old);
PM_SETRE(pm,rx);
- }
}
rxres_restore(&cx->sb_rxres, rx);
sv_pos_b2u(sv, &i);
mg->mg_len = i;
}
- ReREFCNT_inc(rx);
+ if (old != rx)
+ ReREFCNT_inc(rx);
cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
rxres_save(&cx->sb_rxres, rx);
RETURNOP(pm->op_pmreplstart);
PP(pp_mapwhile)
{
dSP;
+ I32 gimme = GIMME_V;
I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
I32 count;
I32 shift;
++PL_markstack_ptr[-1];
/* if there are new items, push them into the destination list */
- if (items) {
+ if (items && gimme != G_VOID) {
/* might need to make room back there first */
if (items > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) {
/* XXX this implementation is very pessimal because the stack
/* All done yet? */
if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
- I32 gimme = GIMME_V;
(void)POPMARK; /* pop top */
LEAVE; /* exit outer scope */
}
}
+/* This code tries to decide if "$left .. $right" should use the
+ magical string increment, or if the range is numeric (we make
+ an exception for .."0" [#18165]). AMS 20021031. */
+
+#define RANGE_IS_NUMERIC(left,right) ( \
+ SvNIOKp(left) || !SvPOKp(left) || \
+ SvNIOKp(right) || !SvPOKp(right) || \
+ (looks_like_number(left) && *SvPVX(left) != '0' && \
+ looks_like_number(right)))
+
PP(pp_flop)
{
dSP;
if (SvGMAGICAL(right))
mg_get(right);
- /* This code tries to decide if "$left .. $right" should use the
- magical string increment, or if the range is numeric (we make
- an exception for .."0" [#18165]). AMS 20021031. */
-
- if (SvNIOKp(left) || !SvPOKp(left) ||
- SvNIOKp(right) || !SvPOKp(right) ||
- (looks_like_number(left) && *SvPVX(left) != '0' &&
- looks_like_number(right)))
- {
+ if (RANGE_IS_NUMERIC(left,right)) {
if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
DIE(aTHX_ "Range iterator outside integer range");
i = SvIV(left);
if (optype == OP_REQUIRE) {
char* msg = SvPVx(ERRSV, n_a);
+ SV *nsv = cx->blk_eval.old_namesv;
+ (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+ &PL_sv_undef, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
SAVETMPS;
if (PL_op->op_targ) {
+ if (PL_op->op_private & OPpLVAL_INTRO) { /* for my $x (...) */
+ SvPADSTALE_off(PAD_SVl(PL_op->op_targ));
+ SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ),
+ SVs_PADSTALE, SVs_PADSTALE);
+ }
#ifndef USE_ITHREADS
svp = &PAD_SVl(PL_op->op_targ); /* "my" variable */
SAVESPTR(*svp);
cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
dPOPss;
- /* See comment in pp_flop() */
- if (SvNIOKp(sv) || !SvPOKp(sv) ||
- SvNIOKp(cx->blk_loop.iterary) || !SvPOKp(cx->blk_loop.iterary) ||
- (looks_like_number(sv) && *SvPVX(sv) != '0' &&
- looks_like_number((SV*)cx->blk_loop.iterary)))
- {
+ if (RANGE_IS_NUMERIC(sv,(SV*)cx->blk_loop.iterary)) {
if (SvNV(sv) < IV_MIN ||
SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
DIE(aTHX_ "Range iterator outside integer range");
switch (CxTYPE(cx)) {
case CXt_SUB:
popsub2 = TRUE;
+ cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
break;
case CXt_EVAL:
if (!(PL_in_eval & EVAL_KEEPERR))
LEAVE;
/* Stack values are safe: */
if (popsub2) {
+ cxstack_ix--;
POPSUB(cx,sv); /* release CV and @_ ... */
}
else
dounwind(cxix);
POPBLOCK(cx,newpm);
+ cxstack_ix++; /* temporarily protect top context */
mark = newsp;
switch (CxTYPE(cx)) {
case CXt_LOOP:
PUTBACK;
LEAVE;
+ cxstack_ix--;
/* Stack values are safe: */
switch (pop2) {
case CXt_LOOP:
SAVETMPS;
/* switch to eval mode */
- if (PL_curcop == &PL_compiling) {
+ if (IN_PERL_COMPILETIME) {
SAVECOPSTASH_FREE(&PL_compiling);
CopSTASH_set(&PL_compiling, PL_curstash);
}
PL_hints &= HINT_UTF8;
/* we get here either during compilation, or via pp_regcomp at runtime */
- runtime = PL_op && (PL_op->op_type == OP_REGCOMP);
+ runtime = IN_PERL_RUNTIME;
if (runtime)
runcv = find_runcv(NULL);
PL_op = &dummy;
PL_op->op_type = OP_ENTEREVAL;
PL_op->op_flags = 0; /* Avoid uninit warning. */
- PUSHBLOCK(cx, CXt_EVAL|(PL_curcop == &PL_compiling ? 0 : CXp_REAL), SP);
+ PUSHBLOCK(cx, CXt_EVAL|(IN_PERL_COMPILETIME ? 0 : CXp_REAL), SP);
PUSHEVAL(cx, 0, Nullgv);
if (runtime)
/* XXX DAPM do this properly one year */
*padp = (AV*)SvREFCNT_inc(PL_comppad);
LEAVE;
- if (PL_curcop == &PL_compiling)
+ if (IN_PERL_COMPILETIME)
PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
#ifdef OP_IN_REGISTER
op = PL_opsave;
sv_setpv(ERRSV,"");
if (yyparse() || PL_error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
- PERL_CONTEXT *cx;
+ PERL_CONTEXT *cx = &cxstack[cxstack_ix];
I32 optype = 0; /* Might be reset by POPEVAL. */
STRLEN n_a;
LEAVE;
if (optype == OP_REQUIRE) {
char* msg = SvPVx(ERRSV, n_a);
+ SV *nsv = cx->blk_eval.old_namesv;
+ (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+ &PL_sv_undef, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
DIE(aTHX_ "Null filename used");
TAINT_PROPER("require");
if (PL_op->op_type == OP_REQUIRE &&
- (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0)) &&
- *svp != &PL_sv_undef)
- RETPUSHYES;
+ (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
+ if (*svp != &PL_sv_undef)
+ RETPUSHYES;
+ else
+ DIE(aTHX_ "Compilation failed in require");
+ }
/* prepare to compile file */
PERL_SCRIPT_MODE);
}
}
+ SP--;
}
PUTBACK;
https://perl5.git.perl.org / perl5.git / blobdiff