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;
pm->op_pmflags |= PMf_WHITE;
if (pm->op_pmflags & PMf_KEEP) {
-#ifdef NOTDEF
- if (!(pm->op_pmflags & PMf_FOLD))
- scan_prefix(pm, pm->op_pmregexp->precomp,
- pm->op_pmregexp->prelen);
-#endif
pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */
hoistmust(pm);
cLOGOP->op_first->op_next = op->op_next;
- /* XXX delete push code? */
}
RETURN;
}
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);
- sv_replace(targ, dstr);
+
+ (void)SvOOK_off(targ);
+ Safefree(SvPVX(targ));
+ SvPVX(targ) = SvPVX(dstr);
+ SvCUR_set(targ, SvCUR(dstr));
+ SvLEN_set(targ, SvLEN(dstr));
+ SvPVX(dstr) = 0;
+ sv_free(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);
}
bool chopspace = (strchr(chopset, ' ') != Nullch);
char *chophere;
char *linemark;
- char *formmark;
- SV **markmark;
double value;
bool gotsome;
STRLEN len;
switch (*fpc++) {
case FF_LINEMARK:
linemark = t;
- formmark = f;
- markmark = MARK;
lines++;
gotsome = FALSE;
break;
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;
char *message;
int oldrunlevel = runlevel;
int was_in_eval = in_eval;
+ HV *stash;
+ GV *gv;
+ CV *cv;
#ifdef I_STDARG
va_start(args, pat);
#endif
message = mess(pat, &args);
va_end(args);
+ if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+ dSP;
+
+ PUSHMARK(sp);
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVpv(message,0)));
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
+ }
restartop = die_where(message);
if ((!restartop && was_in_eval) || oldrunlevel > 1)
longjmp(top_env, 3);
I32 gimme;
SV **newsp;
- sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),message);
+ 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;
stack_sp = newsp;
LEAVE;
+
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)
+ if (e_fp) {
+#ifdef DOSISH
+ fclose(e_fp);
+#endif
(void)UNLINK(e_tmpname);
- statusvalue >>= 8;
+ }
+ statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+ my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
+#else
my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
return 0;
}
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->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);
{
SV **str1 = (SV **) a;
SV **str2 = (SV **) b;
+ I32 oldsaveix = savestack_ix;
I32 oldscopeix = scopestack_ix;
I32 result;
GvSV(firstgv) = *str1;
run();
if (stack_sp != stack_base + 1)
croak("Sort subroutine didn't return single value");
- if (!SvNIOK(*stack_sp))
+ if (!SvNIOKp(*stack_sp))
croak("Sort subroutine didn't return a numeric value");
result = SvIV(*stack_sp);
while (scopestack_ix > oldscopeix) {
LEAVE;
}
+ leave_scope(oldsaveix);
return result;
}
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)))
SV **sp;
register CV *cv;
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = G_ARRAY;
I32 hasargs;
GV *gv;
+ gv = DBgv;
+ cv = GvCV(gv);
+ if (!cv)
+ DIE("No DB::DB routine defined");
+
+ 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;
hasargs = 0;
- gv = DBgv;
- cv = GvCV(gv);
sp = stack_sp;
- *++sp = Nullsv;
-
- if (!cv)
- DIE("No DB::DB routine defined");
- if (CvDEPTH(cv) >= 1) /* don't do recursive DB::DB call */
- return NORMAL;
push_return(op->op_next);
- PUSHBLOCK(cx, CXt_SUB, sp - 1);
+ PUSHBLOCK(cx, CXt_SUB, sp);
PUSHSUB(cx);
CvDEPTH(cv)++;
(void)SvREFCNT_inc(cv);
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;
break;
case CXt_EVAL:
POPEVAL(cx);
+ if (optype == OP_REQUIRE &&
+ (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
+ {
+ char *name = cx->blk_eval.old_name;
+ (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+ DIE("%s did not return a true value", name);
+ }
break;
default:
DIE("panic: return");
*++newsp = sv_mortalcopy(*SP);
else
*++newsp = &sv_undef;
- if (optype == OP_REQUIRE && !SvTRUE(*newsp))
- DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
}
else {
- if (optype == OP_REQUIRE && MARK == SP)
- DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
while (MARK < SP)
*++newsp = sv_mortalcopy(*++MARK);
}
SV **newsp;
PMOP *newpm;
SV **mark = stack_base + cxstack[cxstack_ix].blk_oldsp;
- /* XXX The sp is probably not right yet... */
if (op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
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();
+ SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILL((AV*)svp[1]);
svp = AvARRAY(svp[0]);
- while (ix > 0) {
+ for ( ;ix > 0; ix--) {
if (svp[ix] != &sv_undef) {
- char *name = SvPVX(svp[ix]); /* XXX */
- if (*name == '@')
- av_store(newpad, ix--, sv = (SV*)newAV());
- else if (*name == '%')
- av_store(newpad, ix--, sv = (SV*)newHV());
- else
- av_store(newpad, ix--, sv = NEWSV(0,0));
- SvPADMY_on(sv);
+ char *name = SvPVX(svp[ix]);
+ if (SvFLAGS(svp[ix]) & SVf_FAKE) {
+ /* outer lexical? */
+ av_store(newpad, ix,
+ SvREFCNT_inc(oldpad[ix]) );
+ }
+ else { /* our own lexical */
+ if (*name == '@')
+ av_store(newpad, ix, sv = (SV*)newAV());
+ else if (*name == '%')
+ av_store(newpad, ix, sv = (SV*)newHV());
+ else
+ av_store(newpad, ix, sv = NEWSV(0,0));
+ SvPADMY_on(sv);
+ }
}
else {
- av_store(newpad, ix--, sv = NEWSV(0,0));
+ av_store(newpad, ix, sv = NEWSV(0,0));
SvPADTMP_on(sv);
}
}
/* push wanted frames */
- if (*enterops) {
+ if (*enterops && enterops[1]) {
OP *oldop = op;
- for (ix = 0 + (gotoprobe == main_root); enterops[ix]; ix++) {
+ for (ix = 1; enterops[ix]; ix++) {
op = enterops[ix];
(*op->op_ppaddr)();
}
do_undump = FALSE;
}
+ if (stack == signalstack) {
+ restartop = retop;
+ longjmp(top_env, 3);
+ }
+
RETURNOP(retop);
}
dSP;
OP *saveop = op;
HV *newstash;
+ AV* comppadlist;
in_eval = 1;
SAVEINT(comppad_name_fill);
SAVEINT(min_intro_pending);
SAVEINT(max_intro_pending);
+
+ SAVESPTR(compcv);
+ compcv = (CV*)NEWSV(1104,0);
+ sv_upgrade((SV *)compcv, SVt_PVCV);
+
comppad = newAV();
comppad_name = newAV();
comppad_name_fill = 0;
curpad = AvARRAY(comppad);
padix = 0;
+ comppadlist = newAV();
+ AvREAL_off(comppadlist);
+ 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 */
newstash = curcop->cop_stash;
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(comppad);
- SAVEFREESV(comppad_name);
SAVEFREEOP(eval_root);
if (gimme & G_ARRAY)
list(eval_root);
FILE *tryrsfp = 0;
sv = POPs;
- if (SvNIOK(sv) && !SvPOKp(sv)) {
+ if (SvNIOKp(sv) && !SvPOKp(sv)) {
if (atof(patchlevel) + 0.000999 < SvNV(sv))
DIE("Perl %3.3f required--this is only version %s, stopped",
SvNV(sv),patchlevel);
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)
if (*tmpname == '/' ||
(*tmpname == '.' &&
(tmpname[1] == '/' ||
- (tmpname[1] == '.' && tmpname[2] == '/'))))
+ (tmpname[1] == '.' && tmpname[2] == '/')))
+#ifdef DOSISH
+ || (tmpname[0] && tmpname[1] == ':')
+#endif
+#ifdef VMS
+ || (strchr(tmpname,':') || ((*tmpname == '[' || *tmpname == '<') &&
+ (tmpname[1] == '-' || tmpname[1] == ']' || tmpname[1] == '>')))
+#endif
+ )
{
tryrsfp = fopen(tmpname,"r");
}
I32 i;
for (i = 0; i <= AvFILL(ar); i++) {
+#ifdef VMS
+ if (tounixpath_ts(SvPVx(*av_fetch(ar, i, TRUE), na),buf) == NULL)
+ continue;
+ strcat(buf,name);
+#else
(void)sprintf(buf, "%s/%s",
SvPVx(*av_fetch(ar, i, TRUE), na), name);
+#endif
tryrsfp = fopen(buf, "r");
if (tryrsfp) {
char *s = buf;
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);
if (!SvPV(sv,len) || !len)
RETPUSHUNDEF;
+ TAINT_PROPER("eval");
ENTER;
- SAVETMPS;
lex_start(sv);
+ SAVETMPS;
/* switch to eval mode */
+ SAVESPTR(compiling.cop_filegv);
sprintf(tmpbuf, "_<(eval %d)", ++evalseq);
compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
compiling.cop_line = 1;
if (!(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
/* Unassume the success we assumed earlier. */
- (void)hv_delete(GvHVn(incgv), name, strlen(name));
+ (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
if (optype == OP_REQUIRE)
retop = die("%s did not return a true value", name);
lex_end();
LEAVE;
- sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+ sv_setpv(GvSV(errgv),"");
RETURNOP(retop);
}
-#ifdef NOTYET
-PP(pp_evalonce)
-{
- dSP;
- SP = do_eval(st[1], OP_EVAL, curcop->cop_stash, TRUE,
- GIMME, arglast);
- if (eval_root) {
- SvREFCNT_dec(cSVOP->op_sv);
- op[1].arg_ptr.arg_cmd = eval_root;
- op[1].op_type = (A_CMD|A_DONT);
- op[0].op_type = OP_TRY;
- }
- RETURN;
-}
-#endif
-
PP(pp_entertry)
{
dSP;
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);
}
-
https://perl5.git.perl.org / perl5.git / blobdiff