tmpstr = POPs;
t = SvPV(tmpstr, len);
- if (pm->op_pmregexp) {
- regfree(pm->op_pmregexp);
- pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */
- }
+ /* JMR: Check against the last compiled regexp */
+ if ( ! pm->op_pmregexp || ! pm->op_pmregexp->precomp
+ || strnNE(pm->op_pmregexp->precomp, t, len)
+ || pm->op_pmregexp->precomp[len]) {
+ if (pm->op_pmregexp) {
+ pregfree(pm->op_pmregexp);
+ pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */
+ }
- pm->op_pmregexp = regcomp(t, t + len, pm);
+ pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */
+ pm->op_pmregexp = pregcomp(t, t + len, pm);
+ }
if (!pm->op_pmregexp->prelen && curpm)
pm = curpm;
register char *s = cx->sb_s;
register char *m = cx->sb_m;
char *orig = cx->sb_orig;
- register REGEXP *rx = pm->op_pmregexp;
+ register REGEXP *rx = cx->sb_rx;
if (cx->sb_iters++) {
if (cx->sb_iters > cx->sb_maxiters)
rx->subbase = cx->sb_subbase;
/* Are we done */
- if (cx->sb_once || !regexec(rx, s, cx->sb_strend, orig,
+ if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig,
s == m, Nullsv, cx->sb_safebase))
{
SV *targ = cx->sb_targ;
sv_catpvn(dstr, s, cx->sb_strend - s);
+ (void)SvOOK_off(targ);
+ Safefree(SvPVX(targ));
SvPVX(targ) = SvPVX(dstr);
SvCUR_set(targ, SvCUR(dstr));
SvLEN_set(targ, SvLEN(dstr));
(void)SvPOK_only(targ);
SvSETMAGIC(targ);
PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
+ LEAVE_SCOPE(cx->sb_oldsave);
POPSUBST(cx);
RETURNOP(pm->op_next);
}
register SV *sv;
I32 max;
- if (SvNIOK(left) || !SvPOK(left) ||
+ if (SvNIOKp(left) || !SvPOKp(left) ||
(looks_like_number(left) && *SvPVX(left) != '0') ) {
i = SvIV(left);
max = SvIV(right);
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
- while (!SvNIOK(sv) && SvCUR(sv) <= len &&
+ while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
strNE(SvPVX(sv),tmps) ) {
XPUSHs(sv);
sv = sv_2mortal(newSVsv(sv));
return i;
}
+I32
+dowantarray()
+{
+ I32 cxix;
+
+ cxix = dopoptosub(cxstack_ix);
+ if (cxix < 0)
+ return G_SCALAR;
+
+ if (cxstack[cxix].blk_gimme == G_ARRAY)
+ return G_ARRAY;
+ else
+ return G_SCALAR;
+}
+
static I32
dopoptosub(startingblock)
I32 startingblock;
}
restartop = die_where(message);
if ((!restartop && was_in_eval) || oldrunlevel > 1)
- longjmp(top_env, 3);
+ Siglongjmp(top_env, 3);
return restartop;
}
register CONTEXT *cx;
I32 gimme;
SV **newsp;
- SV *errsv;
-
- errsv = GvSV(gv_fetchpv("@",TRUE, SVt_PV));
- /* As destructors may produce errors we set $@ at the last moment */
- sv_setpv(errsv, ""); /* clear $@ before destroying */
+ if (in_eval & 4) {
+ SV **svp;
+ STRLEN klen = strlen(message);
+
+ svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+ if (svp) {
+ if (!SvIOK(*svp)) {
+ static char prefix[] = "\t(in cleanup) ";
+ sv_upgrade(*svp, SVt_IV);
+ (void)SvIOK_only(*svp);
+ SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
+ sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
+ sv_catpvn(GvSV(errgv), message, klen);
+ }
+ sv_inc(*svp);
+ }
+ }
+ else
+ sv_setpv(GvSV(errgv), message);
+
cxix = dopoptoeval(cxstack_ix);
if (cxix >= 0) {
I32 optype;
LEAVE;
- sv_insert(errsv, 0, 0, message, strlen(message));
if (optype == OP_REQUIRE)
- DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
+ DIE("%s", SvPVx(GvSV(errgv), na));
return pop_return();
}
}
fputs(message, stderr);
- (void)fflush(stderr);
- if (e_fp)
+ (void)Fflush(stderr);
+ if (e_tmpname) {
+ if (e_fp) {
+ fclose(e_fp);
+ e_fp = Nullfp;
+ }
(void)UNLINK(e_tmpname);
+ Safefree(e_tmpname);
+ e_tmpname = Nullch;
+ }
statusvalue = SHIFTSTATUS(statusvalue);
#ifdef VMS
my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
cxix = dopoptosub(cxix - 1);
}
cx = &cxstack[cxix];
+ if (cxstack[cxix].cx_type == CXt_SUB) {
+ dbcxix = dopoptosub(cxix - 1);
+ /* We expect that cxstack[dbcxix] is CXt_SUB, anyway, the
+ field below is defined for any cx. */
+ if (DBsub && dbcxix >= 0 && cxstack[dbcxix].blk_sub.cv == GvCV(DBsub))
+ cx = &cxstack[dbcxix];
+ }
+
if (GIMME != G_ARRAY) {
dTARGET;
PUSHs(TARG);
RETURN;
}
- dbcxix = dopoptosub(cxix - 1);
- if (DBsub && dbcxix >= 0 && cxstack[dbcxix].blk_sub.cv == GvCV(DBsub))
- cx = &cxstack[dbcxix];
PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
if (!MAXARG)
RETURN;
- if (cx->cx_type == CXt_SUB) {
+ if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */
sv = NEWSV(49, 0);
gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv));
PUSHs(sv_2mortal(sv));
PUSHs(sv_2mortal(newSViv(0)));
}
PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme)));
- if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
- PUSHs(cx->blk_eval.cur_text);
-
- if (cx->blk_sub.hasargs && curcop->cop_stash == debstash) {
+ if (cx->cx_type == CXt_EVAL) {
+ if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
+ PUSHs(cx->blk_eval.cur_text);
+ PUSHs(&sv_no);
+ }
+ else if (cx->blk_eval.old_name) { /* Try blocks have old_name == 0. */
+ /* Require, put the name. */
+ PUSHs(sv_2mortal(newSVpv(cx->blk_eval.old_name, 0)));
+ PUSHs(&sv_yes);
+ }
+ }
+ else if (cx->cx_type == CXt_SUB &&
+ cx->blk_sub.hasargs &&
+ curcop->cop_stash == debstash)
+ {
AV *ary = cx->blk_sub.argarray;
int off = AvARRAY(ary) - AvALLOC(ary);
GV* tmpgv;
dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
SVt_PVAV)));
- SvMULTI_on(tmpgv);
+ GvMULTI_on(tmpgv);
AvREAL_off(dbargs); /* XXX Should be REIFY */
}
GvSV(secondgv) = *str2;
stack_sp = stack_base;
op = sortcop;
- run();
+ runops();
if (stack_sp != stack_base + 1)
croak("Sort subroutine didn't return single value");
if (!SvNIOKp(*stack_sp))
register SV *str2 = *(SV **) b;
I32 retval;
+ if (!SvPOKp(str1)) {
+ if (!SvPOKp(str2))
+ return 0;
+ else
+ return -1;
+ }
+ if (!SvPOKp(str2))
+ return 1;
+
if (SvCUR(str1) < SvCUR(str2)) {
/*SUPPRESS 560*/
if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str1)))
I32 hasargs;
GV *gv;
- ENTER;
- SAVETMPS;
-
gv = DBgv;
cv = GvCV(gv);
if (!cv)
DIE("No DB::DB routine defined");
- if (CvDEPTH(cv) >= 1) /* don't do recursive DB::DB call */
+ if (CvDEPTH(cv) >= 1 && !(debug & (1<<30))) /* don't do recursive DB::DB call */
return NORMAL;
+ ENTER;
+ SAVETMPS;
+
SAVEI32(debug);
SAVESPTR(stack_sp);
debug = 0;
I32 gimme = GIMME;
SV **svp;
+ ENTER;
+ SAVETMPS;
+
if (op->op_targ)
svp = &curpad[op->op_targ]; /* "my" variable */
else
svp = &GvSV((GV*)POPs); /* symbol table variable */
- ENTER;
- SAVETMPS;
+ SAVESPTR(*svp);
+
ENTER;
PUSHBLOCK(cx, CXt_LOOP, SP);
PUSHLOOP(cx, svp, MARK);
- cx->blk_loop.iterary = stack;
- cx->blk_loop.iterix = MARK - stack_base;
+ if (op->op_flags & OPf_STACKED) {
+ AV* av = (AV*)POPs;
+ cx->blk_loop.iterary = av;
+ cx->blk_loop.iterix = -1;
+ }
+ else {
+ cx->blk_loop.iterary = stack;
+ AvFILL(stack) = sp - stack_base;
+ cx->blk_loop.iterix = MARK - stack_base;
+ }
RETURN;
}
if (stack == sortstack) {
if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
+ if (cxstack_ix > sortcxix)
+ dounwind(sortcxix);
AvARRAY(stack)[1] = *SP;
stack_sp = stack_base + 1;
return 0;
I32 items = 0;
I32 oldsave;
+ if (!CvROOT(cv) && !CvXSUB(cv)) {
+ if (CvGV(cv)) {
+ SV *tmpstr = sv_newmortal();
+ gv_efullname(tmpstr, CvGV(cv));
+ DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
+ }
+ DIE("Goto undefined subroutine");
+ }
+
/* First do some returnish stuff. */
cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
Copy(AvARRAY(av), ++stack_sp, items, SV*);
stack_sp += items;
GvAV(defgv) = cx->blk_sub.savearray;
- av_clear(av);
AvREAL_off(av);
+ av_clear(av);
}
if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
SvREFCNT_dec(cx->blk_sub.cv);
GvENAME(CvGV(cv)));
if (CvDEPTH(cv) > AvFILL(padlist)) {
AV *newpad = newAV();
- AV *oldpad = (AV*)AvARRAY(svp[CvDEPTH(cv)-1]);
+ SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILL((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
if (SvFLAGS(svp[ix]) & SVf_FAKE) {
/* outer lexical? */
av_store(newpad, ix,
- SvREFCNT_inc(AvARRAY(oldpad)[ix]) );
+ SvREFCNT_inc(oldpad[ix]) );
}
else { /* our own lexical */
if (*name == '@')
}
if (do_dump) {
+#ifdef VMS
+ if (!retop) retop = main_start;
+#endif
restartop = retop;
do_undump = TRUE;
if (stack == signalstack) {
restartop = retop;
- longjmp(top_env, 3);
+ Siglongjmp(top_env, 3);
}
RETURNOP(retop);
comppadlist = newAV();
AvREAL_off(comppadlist);
- av_store(comppadlist, 0, SvREFCNT_inc((SV*)comppad_name));
- av_store(comppadlist, 1, SvREFCNT_inc((SV*)comppad));
+ av_store(comppadlist, 0, (SV*)comppad_name);
+ av_store(comppadlist, 1, (SV*)comppad);
CvPADLIST(compcv) = comppadlist;
+ SAVEFREESV(compcv);
/* make sure we compile in the right package */
error_count = 0;
curcop = &compiling;
curcop->cop_arybase = 0;
- rs = "\n";
- rslen = 1;
- rschar = '\n';
- rspara = 0;
- sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+ SvREFCNT_dec(rs);
+ rs = newSVpv("\n", 1);
+ sv_setpv(GvSV(errgv),"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
lex_end();
LEAVE;
if (optype == OP_REQUIRE)
- DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
- rs = nrs;
- rslen = nrslen;
- rschar = nrschar;
- rspara = (nrslen == 2);
+ DIE("%s", SvPVx(GvSV(errgv), na));
+ SvREFCNT_dec(rs);
+ rs = SvREFCNT_inc(nrs);
RETPUSHUNDEF;
}
- rs = nrs;
- rslen = nrslen;
- rschar = nrschar;
- rspara = (nrslen == 2);
+ SvREFCNT_dec(rs);
+ rs = SvREFCNT_inc(nrs);
compiling.cop_line = 0;
- SAVEFREESV(compcv);
SAVEFREEOP(eval_root);
if (gimme & G_ARRAY)
list(eval_root);
FILE *tryrsfp = 0;
sv = POPs;
- if (SvNIOK(sv) && !SvPOKp(sv)) {
- if (atof(patchlevel) + 0.000999 < SvNV(sv))
- DIE("Perl %3.3f required--this is only version %s, stopped",
- SvNV(sv),patchlevel);
+ if (SvNIOKp(sv) && !SvPOKp(sv)) {
+ if (atof(patchlevel) + 0.00000999 < SvNV(sv))
+ DIE("Perl %s required--this is only version %s, stopped",
+ SvPV(sv,na),patchlevel);
RETPUSHYES;
}
name = SvPV(sv, na);
if (!*name)
DIE("Null filename used");
+ TAINT_PROPER("require");
if (op->op_type == OP_REQUIRE &&
(svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
*svp != &sv_undef)
(*tmpname == '.' &&
(tmpname[1] == '/' ||
(tmpname[1] == '.' && tmpname[2] == '/')))
+#ifdef DOSISH
+ || (tmpname[0] && tmpname[1] == ':')
+#endif
#ifdef VMS
- || ((*tmpname == '[' || *tmpname == '<') &&
- (tmpname[1] == '-' || tmpname[1] == ']' || tmpname[1] == '>'))
+ || (strchr(tmpname,':') || ((*tmpname == '[' || *tmpname == '<') &&
+ (tmpname[1] == '-' || tmpname[1] == ']' || tmpname[1] == '>')))
#endif
)
{
for (i = 0; i <= AvFILL(ar); i++) {
#ifdef VMS
if (tounixpath_ts(SvPVx(*av_fetch(ar, i, TRUE), na),buf) == NULL)
- croak("Error converting file specification %s",
- SvPVx(*av_fetch(ar, i, TRUE), na));
- strcat(buf,name);
+ continue;
+ strcat(buf,name);
#else
(void)sprintf(buf, "%s/%s",
SvPVx(*av_fetch(ar, i, TRUE), na), name);
ENTER;
SAVETMPS;
lex_start(sv_2mortal(newSVpv("",0)));
+ if (rsfp_filters){
+ save_aptr(&rsfp_filters);
+ rsfp_filters = NULL;
+ }
+
rsfp = tryrsfp;
name = savepv(name);
SAVEFREEPV(name);
lex_end();
LEAVE;
- sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+ sv_setpv(GvSV(errgv),"");
RETURNOP(retop);
}
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
- sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+ sv_setpv(GvSV(errgv),"");
RETURN;
}
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+ sv_setpv(GvSV(errgv),"");
RETURN;
}
Safefree(fops);
SvCOMPILED_on(sv);
}
-
projects / p5sagit/p5-mst-13.2.git / blobdiff