if (SvROK(tmpstr)) {
SV *sv = SvRV(tmpstr);
if(SvMAGICAL(sv))
- mg = mg_find(sv, 'r');
+ mg = mg_find(sv, PERL_MAGIC_qr);
}
if (mg) {
regexp *re = (regexp *)mg->mg_obj;
register char *m = cx->sb_m;
char *orig = cx->sb_orig;
register REGEXP *rx = cx->sb_rx;
-
+
rxres_restore(&cx->sb_rxres, rx);
if (cx->sb_iters++) {
I32 i;
if (SvTYPE(sv) < SVt_PVMG)
(void)SvUPGRADE(sv, SVt_PVMG);
- if (!(mg = mg_find(sv, 'g'))) {
- sv_magic(sv, Nullsv, 'g', Nullch, 0);
- mg = mg_find(sv, 'g');
+ if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
+ sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
+ mg = mg_find(sv, PERL_MAGIC_regex_global);
}
i = m - orig;
if (DO_UTF8(sv))
if (item_is_utf) {
while (arg--) {
if (UTF8_IS_CONTINUED(*s)) {
- switch (UTF8SKIP(s)) {
+ STRLEN skip = UTF8SKIP(s);
+ switch (skip) {
+ default:
+ Move(s,t,skip,char);
+ s += skip;
+ t += skip;
+ break;
case 7: *t++ = *s++;
case 6: *t++ = *s++;
case 5: *t++ = *s++;
if (PL_op->op_private & OPpFLIP_LINENUM) {
struct io *gp_io;
flip = PL_last_in_gv
- && (gp_io = GvIOp(PL_last_in_gv))
+ && (gp_io = GvIO(PL_last_in_gv))
&& SvIV(sv) == (IV)IoLINES(gp_io);
} else {
flip = SvTRUE(sv);
SV *targ = PAD_SV(cUNOP->op_first->op_targ);
sv_inc(targ);
if ((PL_op->op_private & OPpFLIP_LINENUM)
- ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
+ ? (GvIO(PL_last_in_gv)
+ && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
: SvTRUE(sv) ) {
sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
sv_catpv(targ, "E0");
}
}
-/*
- * Closures mentioned at top level of eval cannot be referenced
- * again, and their presence indirectly causes a memory leak.
- * (Note that the fact that compcv and friends are still set here
- * is, AFAIK, an accident.) --Chip
- *
- * XXX need to get comppad et al from eval's cv rather than
- * relying on the incidental global values.
- */
-STATIC void
-S_free_closures(pTHX)
-{
- SV **svp = AvARRAY(PL_comppad_name);
- I32 ix;
- for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
- SV *sv = svp[ix];
- if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') {
- SvREFCNT_dec(sv);
- svp[ix] = &PL_sv_undef;
-
- sv = PL_curpad[ix];
- if (CvCLONE(sv)) {
- SvREFCNT_dec(CvOUTSIDE(sv));
- CvOUTSIDE(sv) = Nullcv;
- }
- else {
- SvREFCNT_dec(sv);
- sv = NEWSV(0,0);
- SvPADTMP_on(sv);
- PL_curpad[ix] = sv;
- }
- }
- }
-}
-
void
Perl_qerror(pTHX_ SV *err)
{
if (!cv)
DIE(aTHX_ "No DB::DB routine defined");
- if (CvDEPTH(cv) >= 1 && !(PL_debug & (1<<30))) /* don't do recursive DB::DB call */
+ if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG))
+ /* don't do recursive DB::DB call */
return NORMAL;
ENTER;
POPEVAL(cx);
if (CxTRYBLOCK(cx))
break;
- if (AvFILLp(PL_comppad_name) >= 0)
- free_closures();
lex_end();
if (optype == OP_REQUIRE &&
(MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
if (cxix < cxstack_ix)
dounwind(cxix);
TOPBLOCK(cx);
- if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
+ if (CxREALEVAL(cx))
DIE(aTHX_ "Can't goto subroutine from an eval-string");
mark = PL_stack_sp;
if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
if (label && *label) {
OP *gotoprobe = 0;
+ bool leaving_eval = FALSE;
+ PERL_CONTEXT *last_eval_cx = 0;
/* find label */
cx = &cxstack[ix];
switch (CxTYPE(cx)) {
case CXt_EVAL:
- gotoprobe = PL_eval_root; /* XXX not good for nested eval */
- break;
+ leaving_eval = TRUE;
+ if (CxREALEVAL(cx)) {
+ gotoprobe = (last_eval_cx ?
+ last_eval_cx->blk_eval.old_eval_root :
+ PL_eval_root);
+ last_eval_cx = cx;
+ break;
+ }
+ /* else fall through */
case CXt_LOOP:
gotoprobe = cx->blk_oldcop->op_sibling;
break;
if (!retop)
DIE(aTHX_ "Can't find label %s", label);
+ /* if we're leaving an eval, check before we pop any frames
+ that we're not going to punt, otherwise the error
+ won't be caught */
+
+ if (leaving_eval && *enterops && enterops[1]) {
+ I32 i;
+ for (i = 1; enterops[i]; i++)
+ if (enterops[i]->op_type == OP_ENTERITER)
+ DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
+ }
+
/* pop unwanted frames */
if (ix < cxstack_ix) {
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller);
}
- SAVEFREESV(PL_compcv);
+ SAVEMORTALIZESV(PL_compcv); /* must remain until end of current statement */
/* make sure we compile in the right package */
char *tryname;
SV *namesv = Nullsv;
SV** svp;
- I32 gimme = G_SCALAR;
+ I32 gimme = GIMME_V;
PerlIO *tryrsfp = 0;
STRLEN n_a;
int filter_has_file = 0;
sv = POPs;
if (SvNIOKp(sv)) {
- if (SvPOK(sv) && SvNOK(sv)) { /* require v5.6.1 */
+ if (SvPOK(sv) && SvNOK(sv) && SvNV(sv)) { /* require v5.6.1 */
UV rev = 0, ver = 0, sver = 0;
STRLEN len;
U8 *s = (U8*)SvPVX(sv);
U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
if (s < end) {
- rev = utf8_to_uv(s, end - s, &len, 0);
+ rev = utf8n_to_uvchr(s, end - s, &len, 0);
s += len;
if (s < end) {
- ver = utf8_to_uv(s, end - s, &len, 0);
+ ver = utf8n_to_uvchr(s, end - s, &len, 0);
s += len;
if (s < end)
- sver = utf8_to_uv(s, end - s, &len, 0);
+ sver = utf8n_to_uvchr(s, end - s, &len, 0);
}
}
if (PERL_REVISION < rev
PL_eval_owner = thr;
MUTEX_UNLOCK(&PL_eval_mutex);
#endif /* USE_THREADS */
- return DOCATCH(doeval(G_SCALAR, NULL));
+ return DOCATCH(doeval(gimme, NULL));
}
PP(pp_dofile)
}
PL_curpm = newpm; /* Don't pop $1 et al till now */
- if (AvFILLp(PL_comppad_name) >= 0)
- free_closures();
-
#ifdef DEBUGGING
assert(CvDEPTH(PL_compcv) == 1);
#endif
push_return(cLOGOP->op_other->op_next);
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP);
PUSHEVAL(cx, 0, 0);
- PL_eval_root = PL_op; /* Only needed so that goto works right. */
PL_in_eval = EVAL_INEVAL;
sv_setpv(ERRSV,"");
}
Copy(fops, s, arg, U16);
Safefree(fops);
- sv_magic(sv, Nullsv, 'f', Nullch, 0);
+ sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0);
SvCOMPILED_on(sv);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff