case FF_END: name = "END"; break;
}
if (arg >= 0)
- fprintf(stderr, "%-16s%ld\n", name, (long) arg);
+ PerlIO_printf(PerlIO_stderr(), "%-16s%ld\n", name, (long) arg);
else
- fprintf(stderr, "%-16s\n", name);
+ PerlIO_printf(PerlIO_stderr(), "%-16s\n", name);
} )
switch (*fpc++) {
case FF_LINEMARK:
if (!(cv && CvROOT(cv))) {
if (gv) {
SV *tmpstr = sv_newmortal();
- gv_efullname(tmpstr, gv);
+ gv_efullname3(tmpstr, gv, Nullch);
if (cv && CvXSUB(cv))
DIE("Xsub \"%s\" called in sort", SvPVX(tmpstr));
DIE("Undefined sort subroutine \"%s\" called",
SAVETMPS;
SAVESPTR(op);
- oldstack = stack;
+ oldstack = curstack;
if (!sortstack) {
sortstack = newAV();
AvREAL_off(sortstack);
av_extend(sortstack, 32);
}
- SWITCHSTACK(stack, sortstack);
+ SWITCHSTACK(curstack, sortstack);
if (sortstash != stash) {
firstgv = gv_fetchpv("a", TRUE, SVt_PV);
secondgv = gv_fetchpv("b", TRUE, SVt_PV);
while (cxstack_ix > cxix) {
cx = &cxstack[cxstack_ix--];
- DEBUG_l(fprintf(stderr, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
+ DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
block_type[cx->cx_type]));
/* Note: we don't need to restore the base context info till the end. */
switch (cx->cx_type) {
GV *gv;
CV *cv;
+ /* We have to switch back to mainstack or die_where may try to pop
+ * the eval block from the wrong stack if die is being called from a
+ * signal handler. - dkindred@cs.cmu.edu */
+ if (curstack != mainstack) {
+ dSP;
+ SWITCHSTACK(curstack, mainstack);
+ }
#ifdef I_STDARG
va_start(args, pat);
#else
POPBLOCK(cx,curpm);
if (cx->cx_type != CXt_EVAL) {
- fprintf(stderr, "panic: die %s", message);
+ PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
my_exit(1);
}
POPEVAL(cx);
return pop_return();
}
}
- fputs(message, stderr);
- (void)Fflush(stderr);
+ PerlIO_printf(PerlIO_stderr(), "%s",message);
+ PerlIO_flush(PerlIO_stderr());
if (e_tmpname) {
if (e_fp) {
- fclose(e_fp);
+ PerlIO_close(e_fp);
e_fp = Nullfp;
}
(void)UNLINK(e_tmpname);
RETURN;
if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */
sv = NEWSV(49, 0);
- gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv));
+ gv_efullname3(sv, CvGV(cxstack[cxix].blk_sub.cv), Nullch);
PUSHs(sv_2mortal(sv));
PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
}
if (!SvPOKp(str2))
return 1;
+ if (lc_collate_active) { /* NOTE: this is the LC_COLLATE branch */
+ register char * pv1, * pv2, * pvx;
+ STRLEN cur1, cur2, curx;
+
+ pv1 = SvPV(str1, cur1);
+ pvx = mem_collxfrm(pv1, cur1, &curx);
+ pv1 = pvx;
+ cur1 = curx;
+
+ pv2 = SvPV(str2, cur2);
+ pvx = mem_collxfrm(pv2, cur2, &curx);
+ pv2 = pvx;
+ cur2 = curx;
+
+ retval = memcmp((void *)pv1, (void *)pv2, cur1 < cur2 ? cur1 : cur2);
+
+ Safefree(pv1);
+ Safefree(pv2);
+
+ if (retval)
+ return retval < 0 ? -1 : 1;
+
+ if (cur1 == cur2)
+ return 0;
+ else
+ return cur1 < cur2 ? -1 : 1;
+ }
+
+ /* NOTE: this is the non-LC_COLLATE area */
+
if (SvCUR(str1) < SvCUR(str2)) {
/*SUPPRESS 560*/
if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str1)))
cx->blk_loop.iterix = -1;
}
else {
- cx->blk_loop.iterary = stack;
- AvFILL(stack) = sp - stack_base;
+ cx->blk_loop.iterary = curstack;
+ AvFILL(curstack) = sp - stack_base;
cx->blk_loop.iterix = MARK - stack_base;
}
PMOP *newpm;
I32 optype = 0;
- if (stack == sortstack) {
+ if (curstack == sortstack) {
if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
if (cxstack_ix > sortcxix)
dounwind(sortcxix);
- AvARRAY(stack)[1] = *SP;
+ AvARRAY(curstack)[1] = *SP;
stack_sp = stack_base + 1;
return 0;
}
if (!CvROOT(cv) && !CvXSUB(cv)) {
if (CvGV(cv)) {
SV *tmpstr = sv_newmortal();
- gv_efullname(tmpstr, CvGV(cv));
+ gv_efullname3(tmpstr, CvGV(cv), Nullch);
DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
}
DIE("Goto undefined subroutine");
AV* av = cx->blk_sub.argarray;
items = AvFILL(av) + 1;
- Copy(AvARRAY(av), ++stack_sp, items, SV*);
+ stack_sp++;
+ EXTEND(stack_sp, items); /* @_ could have been extended. */
+ Copy(AvARRAY(av), stack_sp, items, SV*);
stack_sp += items;
GvAV(defgv) = cx->blk_sub.savearray;
AvREAL_off(av);
sp = stack_base + items;
}
else {
+ stack_sp--; /* There is no cv arg. */
(void)(*CvXSUB(cv))(cv);
}
LEAVE;
mark++;
}
}
+ if (perldb && curstash != debstash) {
+ /* &xsub is not copying @_ */
+ SV *sv = GvSV(DBsub);
+ save_item(sv);
+ gv_efullname3(sv, CvGV(cv), Nullch);
+ /* We do not care about using sv to call CV,
+ * just for info. */
+ }
RETURNOP(CvSTART(cv));
}
}
do_undump = FALSE;
}
- if (stack == signalstack) {
+ if (curstack == signalstack) {
restartop = retop;
Siglongjmp(top_env, 3);
}
in_eval = 1;
+ PUSHMARK(SP);
+
/* set up a scratch pad */
SAVEINT(padix);
curcop->cop_arybase = 0;
SvREFCNT_dec(rs);
rs = newSVpv("\n", 1);
- sv_setpv(GvSV(errgv),"");
+ if (saveop->op_flags & OPf_SPECIAL)
+ in_eval |= 4;
+ else
+ sv_setpv(GvSV(errgv),"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
op_free(eval_root);
eval_root = Nullop;
}
+ SP = stack_base + POPMARK; /* pop original mark */
POPBLOCK(cx,curpm);
POPEVAL(cx);
pop_return();
/* compiled okay, so do it */
+ SP = stack_base + POPMARK; /* pop original mark */
RETURNOP(eval_start);
}
char *tmpname;
SV** svp;
I32 gimme = G_SCALAR;
- FILE *tryrsfp = 0;
+ PerlIO *tryrsfp = 0;
sv = POPs;
if (SvNIOKp(sv) && !SvPOKp(sv)) {
#endif
)
{
- tryrsfp = fopen(tmpname,"r");
+ tryrsfp = PerlIO_open(tmpname,"r");
}
else {
AV *ar = GvAVn(incgv);
(void)sprintf(buf, "%s/%s",
SvPVx(*av_fetch(ar, i, TRUE), na), name);
#endif
- tryrsfp = fopen(buf, "r");
+ tryrsfp = PerlIO_open(buf, "r");
if (tryrsfp) {
char *s = buf;
I32 gimme;
register CONTEXT *cx;
OP *retop;
+ U8 save_flags = op -> op_flags;
I32 optype;
POPBLOCK(cx,newpm);
}
else {
for (mark = newsp + 1; mark <= SP; mark++)
- if (!(SvFLAGS(TOPs) & SVs_TEMP))
+ if (!(SvFLAGS(*mark) & SVs_TEMP))
*mark = sv_mortalcopy(*mark);
/* in case LEAVE wipes old return values */
}
curpm = newpm; /* Don't pop $1 et al till now */
- if (optype != OP_ENTEREVAL) {
+ if (optype == OP_REQUIRE &&
+ !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
char *name = cx->blk_eval.old_name;
- if (!(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
- /* Unassume the success we assumed earlier. */
- (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
-
- if (optype == OP_REQUIRE)
- retop = die("%s did not return a true value", name);
- }
+ /* Unassume the success we assumed earlier. */
+ (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+ retop = die("%s did not return a true value", name);
}
lex_end();
LEAVE;
- sv_setpv(GvSV(errgv),"");
+ if (!(save_flags & OPf_SPECIAL))
+ sv_setpv(GvSV(errgv),"");
RETURNOP(retop);
}
}
else {
for (mark = newsp + 1; mark <= SP; mark++)
- if (!(SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)))
+ if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
*mark = sv_mortalcopy(*mark);
/* in case LEAVE wipes old return values */
}
projects / p5sagit/p5-mst-13.2.git / blobdiff