return NORMAL;
}
-PP(pp_regcomp) {
+PP(pp_regcomp)
+{
djSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
register char *t;
MAGIC *mg = Null(MAGIC*);
tmpstr = POPs;
- if(SvROK(tmpstr)) {
+ if (SvROK(tmpstr)) {
SV *sv = SvRV(tmpstr);
if(SvMAGICAL(sv))
mg = mg_find(sv, 'r');
}
- if(mg) {
+ if (mg) {
regexp *re = (regexp *)mg->mg_obj;
ReREFCNT_dec(pm->op_pmregexp);
pm->op_pmregexp = ReREFCNT_inc(re);
else {
t = SvPV(tmpstr, len);
- /* JMR: Check against the last compiled regexp
- To know for sure, we'd need the length of precomp.
- But we don't have it, so we must ... take a guess. */
+ /* Check against the last compiled regexp. */
if (!pm->op_pmregexp || !pm->op_pmregexp->precomp ||
- memNE(pm->op_pmregexp->precomp, t, len + 1))
+ pm->op_pmregexp->prelen != len ||
+ memNE(pm->op_pmregexp->precomp, t, len))
{
if (pm->op_pmregexp) {
ReREFCNT_dec(pm->op_pmregexp);
}
pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */
- pm->op_pmregexp = pregcomp(t, t + len, pm);
+ pm->op_pmregexp = CALLREGCOMP(t, t + len, pm);
}
}
+#ifndef INCOMPLETE_TAINTS
+ if (tainting) {
+ if (tainted)
+ pm->op_pmdynflags |= PMdf_TAINTED;
+ else
+ pm->op_pmdynflags &= ~PMdf_TAINTED;
+ }
+#endif
+
if (!pm->op_pmregexp->prelen && curpm)
pm = curpm;
else if (strEQ("\\s+", pm->op_pmregexp->precomp))
if (cx->sb_iters > cx->sb_maxiters)
DIE("Substitution loop");
- if (!cx->sb_rxtainted)
- cx->sb_rxtainted = SvTAINTED(TOPs);
+ if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
+ cx->sb_rxtainted |= 2;
sv_catsv(dstr, POPs);
/* Are we done */
- if (cx->sb_once || !regexec_flags(rx, s, cx->sb_strend, orig,
+ if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
s == m, Nullsv, NULL,
cx->sb_safebase ? 0 : REXEC_COPY_STR))
{
SV *targ = cx->sb_targ;
sv_catpvn(dstr, s, cx->sb_strend - s);
- TAINT_IF(cx->sb_rxtainted || RX_MATCH_TAINTED(rx));
+ cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
(void)SvOOK_off(targ);
Safefree(SvPVX(targ));
SvLEN_set(targ, SvLEN(dstr));
SvPVX(dstr) = 0;
sv_free(dstr);
+
+ TAINT_IF(cx->sb_rxtainted & 1);
+ PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
+
(void)SvPOK_only(targ);
+ TAINT_IF(cx->sb_rxtainted);
SvSETMAGIC(targ);
SvTAINT(targ);
- PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
LEAVE_SCOPE(cx->sb_oldsave);
POPSUBST(cx);
RETURNOP(pm->op_next);
RETPUSHUNDEF;
}
+ ENTER;
+ SAVEPPTR(sortcop);
if (op->op_flags & OPf_STACKED) {
- ENTER;
if (op->op_flags & OPf_SPECIAL) {
OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */
kid = kUNOP->op_first; /* pass rv2gv */
SAVEOP();
CATCH_SET(TRUE);
- PUSHSTACK(SI_SORT);
+ PUSHSTACKi(PERLSI_SORT);
if (sortstash != stash) {
firstgv = gv_fetchpv("a", TRUE, SVt_PV);
secondgv = gv_fetchpv("b", TRUE, SVt_PV);
qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv));
POPBLOCK(cx,curpm);
- POPSTACK();
+ POPSTACK;
CATCH_SET(oldcatch);
}
- LEAVE;
}
else {
if (max > 1) {
: FUNC_NAME_TO_PTR(sv_cmp));
}
}
+ LEAVE;
stack_sp = ORIGMARK + max;
return nextop;
}
if (SvNIOKp(left) || !SvPOKp(left) ||
(looks_like_number(left) && *SvPVX(left) != '0') )
{
+ if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX)
+ croak("Range iterator outside integer range");
i = SvIV(left);
max = SvIV(right);
if (max >= i) {
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
- while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
- strNE(SvPVX(sv),tmps) ) {
+ while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
+ if (strEQ(SvPVX(sv),tmps))
+ break;
sv = sv_2mortal(newSVsv(sv));
sv_inc(sv);
}
- if (strEQ(SvPVX(sv),tmps))
- XPUSHs(sv);
}
}
else {
return G_VOID;
switch (cxstack[cxix].blk_gimme) {
+ case G_VOID:
+ return G_VOID;
case G_SCALAR:
return G_SCALAR;
case G_ARRAY:
return G_ARRAY;
default:
croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
- case G_VOID:
- return G_VOID;
+ /* NOTREACHED */
+ return 0;
}
}
I32 gimme;
SV **newsp;
- if (in_eval & 4) {
- SV **svp;
- STRLEN klen = strlen(message);
-
- svp = hv_fetch(ERRHV, message, klen, TRUE);
- if (svp) {
- if (!SvIOK(*svp)) {
- static char prefix[] = "\t(in cleanup) ";
- SV *err = ERRSV;
- sv_upgrade(*svp, SVt_IV);
- (void)SvIOK_only(*svp);
- if (!SvPOK(err))
- sv_setpv(err,"");
- SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
- sv_catpvn(err, prefix, sizeof(prefix)-1);
- sv_catpvn(err, message, klen);
+ if (message) {
+ if (in_eval & 4) {
+ SV **svp;
+ STRLEN klen = strlen(message);
+
+ svp = hv_fetch(ERRHV, message, klen, TRUE);
+ if (svp) {
+ if (!SvIOK(*svp)) {
+ static char prefix[] = "\t(in cleanup) ";
+ SV *err = ERRSV;
+ sv_upgrade(*svp, SVt_IV);
+ (void)SvIOK_only(*svp);
+ if (!SvPOK(err))
+ sv_setpv(err,"");
+ SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
+ sv_catpvn(err, prefix, sizeof(prefix)-1);
+ sv_catpvn(err, message, klen);
+ }
+ sv_inc(*svp);
}
- sv_inc(*svp);
}
+ else
+ sv_setpv(ERRSV, message);
}
else
- sv_setpv(ERRSV, message);
-
+ message = SvPVx(ERRSV, na);
+
while ((cxix = dopoptoeval(cxstack_ix)) < 0 && curstackinfo->si_prev) {
dounwind(-1);
- POPSTACK();
+ POPSTACK;
}
if (cxix >= 0) {
PUSHBLOCK(cx, CXt_LOOP, SP);
PUSHLOOP(cx, svp, MARK);
- if (op->op_flags & OPf_STACKED)
+ if (op->op_flags & OPf_STACKED) {
cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
+ if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+ dPOPss;
+ if (SvNIOKp(sv) || !SvPOKp(sv) ||
+ (looks_like_number(sv) && *SvPVX(sv) != '0')) {
+ if (SvNV(sv) < IV_MIN ||
+ SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
+ croak("Range iterator outside integer range");
+ cx->blk_loop.iterix = SvIV(sv);
+ cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
+ }
+ else
+ cx->blk_loop.iterlval = newSVsv(sv);
+ }
+ }
else {
cx->blk_loop.iterary = curstack;
AvFILLp(curstack) = SP - stack_base;
PMOP *newpm;
I32 optype = 0;
- if (curstackinfo->si_type == SI_SORT) {
+ if (curstackinfo->si_type == PERLSI_SORT) {
if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) {
if (cxstack_ix > sortcxix)
dounwind(sortcxix);
TAINT_NOT;
if (gimme == G_SCALAR) {
- if (MARK < SP)
- *++newsp = (popsub2 && SvTEMP(*SP))
- ? *SP : sv_mortalcopy(*SP);
- else
+ if (MARK < SP) {
+ if (popsub2) {
+ if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+ if (SvTEMP(TOPs)) {
+ *++newsp = SvREFCNT_inc(*SP);
+ FREETMPS;
+ sv_2mortal(*newsp);
+ } else {
+ FREETMPS;
+ *++newsp = sv_mortalcopy(*SP);
+ }
+ } else
+ *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
+ } else
+ *++newsp = sv_mortalcopy(*SP);
+ } else
*++newsp = &sv_undef;
}
else if (gimme == G_ARRAY) {
AvREAL_off(av);
av_clear(av);
}
+ else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
+ AV* av;
+ int i;
+#ifdef USE_THREADS
+ av = (AV*)curpad[0];
+#else
+ av = GvAV(defgv);
+#endif
+ items = AvFILLp(av) + 1;
+ stack_sp++;
+ EXTEND(stack_sp, items); /* @_ could have been extended. */
+ Copy(AvARRAY(av), stack_sp, items, SV*);
+ stack_sp += items;
+ }
if (cx->cx_type == CXt_SUB &&
!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
SvREFCNT_dec(cx->blk_sub.cv);
SP = stack_base + items;
}
else {
+ SV **newsp;
+ I32 gimme;
+
stack_sp--; /* There is no cv arg. */
- (void)(*CvXSUB(cv))(THIS_ cv);
+ /* Push a mark for the start of arglist */
+ PUSHMARK(mark);
+ (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
+ /* Pop the current context like a decent sub should */
+ POPBLOCK(cx, curpm);
+ /* Do _not_ use PUTBACK, keep the XSUB's return stack! */
}
LEAVE;
return pop_return();
mark++;
}
}
- if (PERLDB_SUB && curstash != debstash) {
+ if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
/*
* We do not care about using sv to call CV;
* it's for informational purposes only.
*/
SV *sv = GvSV(DBsub);
- save_item(sv);
- gv_efullname3(sv, CvGV(cv), Nullch);
+ CV *gotocv;
+
+ if (PERLDB_SUB_NN) {
+ SvIVX(sv) = (IV)cv; /* Already upgraded, saved */
+ } else {
+ save_item(sv);
+ gv_efullname3(sv, CvGV(cv), Nullch);
+ }
+ if ( PERLDB_GOTO
+ && (gotocv = perl_get_cv("DB::goto", FALSE)) ) {
+ PUSHMARK( stack_sp );
+ perl_call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+ stack_sp--;
+ }
}
RETURNOP(CvSTART(cv));
}
introduced within evals. See force_ident(). GSAR 96-10-12 */
safestr = savepv(tmpbuf);
SAVEDELETE(defstash, safestr, strlen(safestr));
- SAVEI32(hints);
+ SAVEHINTS();
#ifdef OP_IN_REGISTER
opsave = op;
#else
rsfp = tryrsfp;
name = savepv(name);
SAVEFREEPV(name);
- SAVEI32(hints);
+ SAVEHINTS();
hints = 0;
/* switch to eval mode */
introduced within evals. See force_ident(). GSAR 96-10-12 */
safestr = savepv(tmpbuf);
SAVEDELETE(defstash, safestr, strlen(safestr));
- SAVEI32(hints);
+ SAVEHINTS();
hints = op->op_targ;
push_return(op->op_next);
/* ****************************************************************** qsort */
-void
+STATIC void
#ifdef PERL_OBJECT
qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare)
#else