/* pp_ctl.c
*
- * Copyright (c) 1991-2001, Larry Wall
+ * Copyright (c) 1991-2002, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* Check against the last compiled regexp. */
if (!PM_GETRE(pm) || !PM_GETRE(pm)->precomp ||
- PM_GETRE(pm)->prelen != len ||
+ PM_GETRE(pm)->prelen != (I32)len ||
memNE(PM_GETRE(pm)->precomp, t, len))
{
if (PM_GETRE(pm)) {
register REGEXP *rx = cx->sb_rx;
rxres_restore(&cx->sb_rxres, rx);
+ PL_reg_match_utf8 = SvUTF8(cx->sb_targ) ? 1 : 0;
if (cx->sb_iters++) {
I32 saviters = cx->sb_iters;
else {
sv = &PL_sv_no;
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX, "Not enough format arguments");
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
}
break;
itemsize = len;
if (DO_UTF8(sv)) {
itemsize = sv_len_utf8(sv);
- if (itemsize != len) {
+ if (itemsize != (I32)len) {
I32 itembytes;
if (itemsize > fieldsize) {
itemsize = fieldsize;
itemsize = len;
if (DO_UTF8(sv)) {
itemsize = sv_len_utf8(sv);
- if (itemsize != len) {
+ if (itemsize != (I32)len) {
I32 itembytes;
if (itemsize <= fieldsize) {
send = chophere = s + itemsize;
}
/* copy the new items down to the destination list */
dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1;
- while (items--)
+ while (items-- > 0)
*dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
}
LEAVE; /* exit inner scope */
else {
dTOPss;
SV *targ = PAD_SV(PL_op->op_targ);
- int flip;
+ int flip = 0;
if (PL_op->op_private & OPpFLIP_LINENUM) {
- struct io *gp_io;
- flip = PL_last_in_gv
- && (gp_io = GvIO(PL_last_in_gv))
- && SvIV(sv) == (IV)IoLINES(gp_io);
+ if (GvIO(PL_last_in_gv)) {
+ flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
+ }
+ else {
+ GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
+ if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv));
+ }
} else {
flip = SvTRUE(sv);
}
else {
dTOPss;
SV *targ = PAD_SV(cUNOP->op_first->op_targ);
+ int flop = 0;
sv_inc(targ);
- if ((PL_op->op_private & OPpFLIP_LINENUM)
- ? (GvIO(PL_last_in_gv)
- && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
- : SvTRUE(sv) ) {
+
+ if (PL_op->op_private & OPpFLIP_LINENUM) {
+ if (GvIO(PL_last_in_gv)) {
+ flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
+ }
+ else {
+ GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
+ if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv));
+ }
+ }
+ else {
+ flop = SvTRUE(sv);
+ }
+
+ if (flop) {
sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
sv_catpv(targ, "E0");
}
switch (CxTYPE(cx)) {
case CXt_SUBST:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
OP_NAME(PL_op));
break;
case CXt_SUB:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
OP_NAME(PL_op));
break;
case CXt_FORMAT:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
OP_NAME(PL_op));
break;
case CXt_EVAL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
OP_NAME(PL_op));
break;
case CXt_NULL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
OP_NAME(PL_op));
return -1;
case CXt_LOOP:
switch (CxTYPE(cx)) {
case CXt_SUBST:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
OP_NAME(PL_op));
break;
case CXt_SUB:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
OP_NAME(PL_op));
break;
case CXt_FORMAT:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
OP_NAME(PL_op));
break;
case CXt_EVAL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
OP_NAME(PL_op));
break;
case CXt_NULL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
OP_NAME(PL_op));
return -1;
case CXt_LOOP:
Perl_die_where(pTHX_ char *message, STRLEN msglen)
{
STRLEN n_a;
+ IO *io;
+ MAGIC *mg;
+
if (PL_in_eval) {
I32 cxix;
register PERL_CONTEXT *cx;
sv_catpvn(err, message, msglen);
if (ckWARN(WARN_MISC)) {
STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
+ Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start);
}
}
}
}
if (!message)
message = SvPVx(ERRSV, msglen);
- {
+
+ /* if STDERR is tied, print to it instead */
+ if (PL_stderrgv && (io = GvIOp(PL_stderrgv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
+ dSP; ENTER;
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ XPUSHs(sv_2mortal(newSVpvn(message, msglen)));
+ PUTBACK;
+ call_method("PRINT", G_SCALAR);
+ LEAVE;
+ }
+ else {
#ifdef USE_SFIO
/* SFIO can really mess with your errno */
int e = errno;
else
RETURNOP(cLOGOP->op_other);
}
-
+
+PP(pp_dorassign)
+{
+ dSP;
+ register SV* sv;
+
+ sv = TOPs;
+ if (!sv || !SvANY(sv)) {
+ RETURNOP(cLOGOP->op_other);
+ }
+
+ switch (SvTYPE(sv)) {
+ case SVt_PVAV:
+ if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
+ RETURN;
+ break;
+ case SVt_PVHV:
+ if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
+ RETURN;
+ break;
+ case SVt_PVCV:
+ if (CvROOT(sv) || CvXSUB(sv))
+ RETURN;
+ break;
+ default:
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
+ if (SvOK(sv))
+ RETURN;
+ }
+
+ RETURNOP(cLOGOP->op_other);
+}
+
PP(pp_caller)
{
dSP;
PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSVpv(stashname, 0)));
- PUSHs(sv_2mortal(newSVpv(CopFILE(cx->blk_oldcop), 0)));
+ PUSHs(sv_2mortal(newSVpv(OutCopFILE(cx->blk_oldcop), 0)));
PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop))));
if (!MAXARG)
RETURN;
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+ GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv);
/* So is ccstack[dbcxix]. */
- sv = NEWSV(49, 0);
- gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
- PUSHs(sv_2mortal(sv));
- PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+ if (isGV(cvgv)) {
+ sv = NEWSV(49, 0);
+ gv_efullname3(sv, cvgv, Nullch);
+ PUSHs(sv_2mortal(sv));
+ PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+ }
+ else {
+ PUSHs(sv_2mortal(newSVpvn("(unknown)",9)));
+ PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+ }
}
else {
PUSHs(sv_2mortal(newSVpvn("(eval)",6)));
return NORMAL;
}
+/* like pp_nextstate, but used instead when the debugger is active */
+
PP(pp_dbstate)
{
PL_curcop = (COP*)PL_op;
register CV *cv;
register PERL_CONTEXT *cx;
I32 gimme = G_ARRAY;
- I32 hasargs;
+ U8 hasargs;
GV *gv;
gv = PL_DBgv;
PUSHSUB(cx);
CvDEPTH(cv)++;
(void)SvREFCNT_inc(cv);
- SAVEVPTR(PL_curpad);
- PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
+ PAD_SET_CUR(CvPADLIST(cv),1);
RETURNOP(CvSTART(cv));
}
else
#endif /* USE_5005THREADS */
if (PL_op->op_targ) {
#ifndef USE_ITHREADS
- svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */
+ svp = &PAD_SVl(PL_op->op_targ); /* "my" variable */
SAVESPTR(*svp);
#else
SAVEPADSV(PL_op->op_targ);
av = newAV();
av_extend(av, items-1);
AvFLAGS(av) = AVf_REIFY;
- PL_curpad[0] = (SV*)(cx->blk_sub.argarray = av);
+ PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
}
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* av;
#ifdef USE_5005THREADS
- av = (AV*)PL_curpad[0];
+ av = (AV*)PAD_SVl(0);
#else
av = GvAV(PL_defgv);
#endif
}
else {
AV* padlist = CvPADLIST(cv);
- SV** svp = AvARRAY(padlist);
if (CxTYPE(cx) == CXt_EVAL) {
PL_in_eval = cx->blk_eval.old_in_eval;
PL_eval_root = cx->blk_eval.old_eval_root;
cx->blk_sub.hasargs = 0;
}
cx->blk_sub.cv = cv;
- cx->blk_sub.olddepth = CvDEPTH(cv);
+ cx->blk_sub.olddepth = (U16)CvDEPTH(cv);
+
CvDEPTH(cv)++;
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
- else { /* save temporaries on recursion? */
+ else {
if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
sub_crush_depth(cv);
- if (CvDEPTH(cv) > AvFILLp(padlist)) {
- AV *newpad = newAV();
- SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
- I32 ix = AvFILLp((AV*)svp[1]);
- I32 names_fill = AvFILLp((AV*)svp[0]);
- svp = AvARRAY(svp[0]);
- for ( ;ix > 0; ix--) {
- if (names_fill >= ix && svp[ix] != &PL_sv_undef) {
- char *name = SvPVX(svp[ix]);
- if ((SvFLAGS(svp[ix]) & SVf_FAKE)
- || *name == '&')
- {
- /* outer lexical or anon code */
- 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 if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
- av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
- }
- else {
- av_store(newpad, ix, sv = NEWSV(0,0));
- SvPADTMP_on(sv);
- }
- }
- if (cx->blk_sub.hasargs) {
- AV* av = newAV();
- av_extend(av, 0);
- av_store(newpad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
- }
- av_store(padlist, CvDEPTH(cv), (SV*)newpad);
- AvFILLp(padlist) = CvDEPTH(cv);
- svp = AvARRAY(padlist);
- }
+ pad_push(padlist, CvDEPTH(cv), cx->blk_sub.hasargs);
}
#ifdef USE_5005THREADS
if (!cx->blk_sub.hasargs) {
- AV* av = (AV*)PL_curpad[0];
+ AV* av = (AV*)PAD_SVl(0);
items = AvFILLp(av) + 1;
if (items) {
PUTBACK ;
}
}
-#endif /* USE_5005THREADS */
- SAVEVPTR(PL_curpad);
- PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+#endif /* USE_5005THREADS */
+ PAD_SET_CUR(padlist, CvDEPTH(cv));
#ifndef USE_5005THREADS
if (cx->blk_sub.hasargs)
#endif /* USE_5005THREADS */
{
- AV* av = (AV*)PL_curpad[0];
+ AV* av = (AV*)PAD_SVl(0);
SV** ary;
#ifndef USE_5005THREADS
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
#endif /* USE_5005THREADS */
- cx->blk_sub.oldcurpad = PL_curpad;
+ CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
++mark;
{
int ret;
OP *oldop = PL_op;
+ OP *retop;
volatile PERL_SI *cursi = PL_curstackinfo;
dJMPENV;
assert(CATCH_GET == TRUE);
#endif
PL_op = o;
+
+ /* Normally, the leavetry at the end of this block of ops will
+ * pop an op off the return stack and continue there. By setting
+ * the op to Nullop, we force an exit from the inner runops()
+ * loop. DAPM.
+ */
+ retop = pop_return();
+ push_return(Nullop);
+
#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
#endif
break;
case 3:
+ /* die caught by an inner eval - continue inner loop */
if (PL_restartop && cursi == PL_curstackinfo) {
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
}
+ /* a die in this eval - continue in outer loop */
+ if (!PL_restartop)
+ break;
/* FALL THROUGH */
default:
JMPENV_POP;
}
JMPENV_POP;
PL_op = oldop;
- return Nullop;
+ return retop;
}
OP *
*avp = (AV*)SvREFCNT_inc(PL_comppad);
LEAVE;
if (PL_curcop == &PL_compiling)
- PL_compiling.op_private = PL_hints;
+ PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
#ifdef OP_IN_REGISTER
op = PL_opsave;
#endif
dSP;
OP *saveop = PL_op;
CV *caller;
- AV* comppadlist;
I32 i;
PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
PUSHMARK(SP);
- /* set up a scratch pad */
-
- SAVEI32(PL_padix);
- SAVEVPTR(PL_curpad);
- SAVESPTR(PL_comppad);
- SAVESPTR(PL_comppad_name);
- SAVEI32(PL_comppad_name_fill);
- SAVEI32(PL_min_intro_pending);
- SAVEI32(PL_max_intro_pending);
-
caller = PL_compcv;
for (i = cxstack_ix - 1; i >= 0; i--) {
PERL_CONTEXT *cx = &cxstack[i];
MUTEX_INIT(CvMUTEXP(PL_compcv));
#endif /* USE_5005THREADS */
- PL_comppad = newAV();
- av_push(PL_comppad, Nullsv);
- PL_curpad = AvARRAY(PL_comppad);
- PL_comppad_name = newAV();
- PL_comppad_name_fill = 0;
- PL_min_intro_pending = 0;
- PL_padix = 0;
-#ifdef USE_5005THREADS
- av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
- PL_curpad[0] = (SV*)newAV();
- SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
-#endif /* USE_5005THREADS */
+ /* set up a scratch pad */
- comppadlist = newAV();
- AvREAL_off(comppadlist);
- av_store(comppadlist, 0, (SV*)PL_comppad_name);
- av_store(comppadlist, 1, (SV*)PL_comppad);
- CvPADLIST(PL_compcv) = comppadlist;
+ CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
if (!saveop ||
(saveop->op_type != OP_REQUIRE && saveop->op_type != OP_DOFILE))
OP *op;
sv = POPs;
- if (SvNIOKp(sv)) {
+ if (SvNIOKp(sv) && PL_op->op_type != OP_DOFILE) {
if (SvPOK(sv) && SvNOK(sv) && SvNV(sv)) { /* require v5.6.1 */
UV rev = 0, ver = 0, sver = 0;
STRLEN len;
PERL_VERSION, PERL_SUBVERSION);
}
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"v-string in use/require non-portable");
RETPUSHYES;
}
/* help out with the "use 5.6" confusion */
if (sver == 0 && (rev > 5 || (rev == 5 && ver >= 100))) {
- DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--"
- "this is only v%d.%d.%d, stopped"
- " (did you mean v%"UVuf".%03"UVuf"?)",
- rev, ver, sver, PERL_REVISION, PERL_VERSION,
- PERL_SUBVERSION, rev, ver/100);
+ DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required"
+ " (did you mean v%"UVuf".%03"UVuf"?)--"
+ "this is only v%d.%d.%d, stopped",
+ rev, ver, sver, rev, ver/100,
+ PERL_REVISION, PERL_VERSION, PERL_SUBVERSION);
}
else {
DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--"
/* prepare to compile file */
-#ifdef MACOS_TRADITIONAL
- if (PERL_FILE_IS_ABSOLUTE(name)
- || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
- {
+ if (path_is_absolute(name)) {
tryname = name;
tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
- /* We consider paths of the form :a:b ambiguous and interpret them first
- as global then as local
- */
- if (!tryrsfp && *name == ':' && name[1] != ':' && strchr(name+2, ':'))
- goto trylocal;
}
- else
-trylocal: {
-#else
- if (PERL_FILE_IS_ABSOLUTE(name)
- || (*name == '.' && (name[1] == '/' ||
- (name[1] == '.' && name[2] == '/'))))
- {
- tryname = name;
- tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
+#ifdef MACOS_TRADITIONAL
+ if (!tryrsfp) {
+ char newname[256];
+
+ MacPerl_CanonDir(name, newname, 1);
+ if (path_is_absolute(newname)) {
+ tryname = newname;
+ tryrsfp = doopen_pmc(newname,PERL_SCRIPT_MODE);
+ }
}
- else {
#endif
+ if (!tryrsfp) {
AV *ar = GvAVn(PL_incgv);
I32 i;
#ifdef VMS
}
}
else {
+ if (!path_is_absolute(name)
+#ifdef MACOS_TRADITIONAL
+ /* We consider paths of the form :a:b ambiguous and interpret them first
+ as global then as local
+ */
+ || (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
+#endif
+ ) {
char *dir = SvPVx(dirsv, n_a);
#ifdef MACOS_TRADITIONAL
- char buf[256];
- Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf), name+(name[0] == ':'));
+ char buf1[256];
+ char buf2[256];
+
+ MacPerl_CanonDir(name, buf2, 1);
+ Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':'));
#else
#ifdef VMS
char *unixdir;
#endif
TAINT_PROPER("require");
tryname = SvPVX(namesv);
-#ifdef MACOS_TRADITIONAL
- {
- /* Convert slashes in the name part, but not the directory part, to colons */
- char * colon;
- for (colon = tryname+strlen(dir); colon = strchr(colon, '/'); )
- *colon++ = ':';
- }
-#endif
tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
if (tryrsfp) {
if (tryname[0] == '.' && tryname[1] == '/')
tryname += 2;
break;
}
+ }
}
}
}
RETPUSHUNDEF;
}
else
- SETERRNO(0, SS$_NORMAL);
+ SETERRNO(0, SS_NORMAL);
/* Assume success here to prevent recursive requirement. */
len = strlen(name);
STRLEN len;
OP *ret;
- if (!SvPV(sv,len) || !len)
+ if (!SvPV(sv,len))
RETPUSHUNDEF;
TAINT_PROPER("eval");
MUTEX_UNLOCK(&PL_eval_mutex);
#endif /* USE_5005THREADS */
ret = doeval(gimme, NULL);
- if (PERLDB_INTER && was != PL_sub_generation /* Some subs defined here. */
+ if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
&& ret != PL_op->op_next) { /* Successive compilation. */
strcpy(safestr, "_<(eval )"); /* Anything fake and short. */
}
register SV **mark;
SV **newsp;
PMOP *newpm;
+ OP* retop;
I32 gimme;
register PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
POPEVAL(cx);
- pop_return();
+ retop = pop_return();
TAINT_NOT;
if (gimme == G_VOID)
LEAVE;
sv_setpv(ERRSV,"");
- RETURN;
+ RETURNOP(retop);
}
STATIC void
if (postspace)
*fpc++ = FF_SPACE;
*fpc++ = FF_LITERAL;
- *fpc++ = arg;
+ *fpc++ = (U16)arg;
}
postspace = FALSE;
if (s <= send)
skipspaces--;
if (skipspaces) {
*fpc++ = FF_SKIP;
- *fpc++ = skipspaces;
+ *fpc++ = (U16)skipspaces;
}
skipspaces = 0;
if (s <= send)
arg = fpc - linepc + 1;
else
arg = 0;
- *fpc++ = arg;
+ *fpc++ = (U16)arg;
}
if (s < send) {
linepc = fpc;
arg = (s - base) - 1;
if (arg) {
*fpc++ = FF_LITERAL;
- *fpc++ = arg;
+ *fpc++ = (U16)arg;
}
base = s - 1;
}
*fpc++ = s - base; /* fieldsize for FETCH */
*fpc++ = FF_DECIMAL;
- *fpc++ = arg;
+ *fpc++ = (U16)arg;
}
else if (*s == '0' && s[1] == '#') { /* Zero padded decimals */
arg = ischop ? 512 : 0;
}
*fpc++ = s - base; /* fieldsize for FETCH */
*fpc++ = FF_0DECIMAL;
- *fpc++ = arg;
+ *fpc++ = (U16)arg;
}
else {
I32 prespace = 0;
*fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL;
if (prespace)
- *fpc++ = prespace;
+ *fpc++ = (U16)prespace;
*fpc++ = FF_ITEM;
if (ismore)
*fpc++ = FF_MORE;
return len;
}
+/* perhaps someone can come up with a better name for
+ this? it is not really "absolute", per se ... */
+static bool
+S_path_is_absolute(pTHX_ char *name)
+{
+ if (PERL_FILE_IS_ABSOLUTE(name)
+#ifdef MACOS_TRADITIONAL
+ || (*name == ':'))
+#else
+ || (*name == '.' && (name[1] == '/' ||
+ (name[1] == '.' && name[2] == '/'))))
+#endif
+ {
+ return TRUE;
+ }
+ else
+ return FALSE;
+}