/* pp_ctl.c
*
- * Copyright (c) 1991-1999, Larry Wall
+ * Copyright (c) 1991-2000, 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.
PL_reginterp_cnt = I32_MAX; /* Mark as safe. */
pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */
+ if (DO_UTF8(tmpstr))
+ pm->op_pmdynflags |= PMdf_UTF8;
pm->op_pmregexp = CALLREGCOMP(aTHX_ t, t + len, pm);
PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed
inside tie/overload accessors. */
else if (strEQ("\\s+", pm->op_pmregexp->precomp))
pm->op_pmflags |= PMf_WHITE;
+ /* XXX runtime compiled output needs to move to the pad */
if (pm->op_pmflags & PMf_KEEP) {
pm->op_private &= ~OPpRUNTIME; /* no point compiling again */
+#if !defined(USE_ITHREADS) && !defined(USE_THREADS)
+ /* XXX can't change the optree at runtime either */
cLOGOP->op_first->op_next = PL_op->op_next;
+#endif
}
RETURN;
}
NV value;
bool gotsome;
STRLEN len;
- STRLEN fudge = SvCUR(tmpForm) * (IN_UTF8 ? 3 : 1) + 1;
+ STRLEN fudge = SvCUR(tmpForm) * (IN_BYTE ? 1 : 3) + 1;
+ bool item_is_utf = FALSE;
if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
- SvREADONLY_off(tmpForm);
- doparseform(tmpForm);
+ if (SvREADONLY(tmpForm)) {
+ SvREADONLY_off(tmpForm);
+ doparseform(tmpForm);
+ SvREADONLY_on(tmpForm);
+ }
+ else
+ doparseform(tmpForm);
}
SvPV_force(PL_formtarget, len);
case FF_CHECKNL:
item = s = SvPV(sv, len);
itemsize = len;
- if (IN_UTF8) {
+ if (DO_UTF8(sv)) {
itemsize = sv_len_utf8(sv);
if (itemsize != len) {
I32 itembytes;
break;
s++;
}
+ item_is_utf = TRUE;
itemsize = s - item;
sv_pos_b2u(sv, &itemsize);
break;
}
}
+ item_is_utf = FALSE;
if (itemsize > fieldsize)
itemsize = fieldsize;
send = chophere = s + itemsize;
case FF_CHECKCHOP:
item = s = SvPV(sv, len);
itemsize = len;
- if (IN_UTF8) {
+ if (DO_UTF8(sv)) {
itemsize = sv_len_utf8(sv);
if (itemsize != len) {
I32 itembytes;
itemsize = chophere - item;
sv_pos_b2u(sv, &itemsize);
}
+ item_is_utf = TRUE;
break;
}
}
+ item_is_utf = FALSE;
if (itemsize <= fieldsize) {
send = chophere = s + itemsize;
while (s < send) {
case FF_ITEM:
arg = itemsize;
s = item;
- if (IN_UTF8) {
+ if (item_is_utf) {
while (arg--) {
if (*s & 0x80) {
switch (UTF8SKIP(s)) {
case FF_LINEGLOB:
item = s = SvPV(sv, len);
itemsize = len;
+ item_is_utf = FALSE; /* XXX is this correct? */
if (itemsize) {
gotsome = TRUE;
send = s + itemsize;
up = myorigmark + 1;
while (MARK < SP) { /* This may or may not shift down one here. */
/*SUPPRESS 560*/
- if (*up = *++MARK) { /* Weed out nulls. */
+ if ((*up = *++MARK)) { /* Weed out nulls. */
SvTEMP_off(*up);
if (!PL_sortcop && !SvPOK(*up)) {
STRLEN n_a;
mg_get(right);
if (SvNIOKp(left) || !SvPOKp(left) ||
- (looks_like_number(left) && *SvPVX(left) != '0') )
+ SvNIOKp(right) || !SvPOKp(right) ||
+ (looks_like_number(left) && *SvPVX(left) != '0' &&
+ looks_like_number(right) && *SvPVX(right) != '0'))
{
if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
DIE(aTHX_ "Range iterator outside integer range");
cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
{
dTHR;
register PERL_CONTEXT *cx;
- SV **newsp;
I32 optype;
while (cxstack_ix > cxix) {
else if (PL_errors)
sv_catsv(PL_errors, err);
else
- Perl_warn(aTHX_ "%_", err);
+ Perl_warn(aTHX_ "%"SVf, err);
++PL_error_count;
}
OP *
Perl_die_where(pTHX_ char *message, STRLEN msglen)
{
- dSP;
STRLEN n_a;
if (PL_in_eval) {
I32 cxix;
SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
sv_catpvn(err, prefix, sizeof(prefix)-1);
sv_catpvn(err, message, msglen);
- if (ckWARN(WARN_UNSAFE)) {
+ if (ckWARN(WARN_MISC)) {
STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
+ Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
}
}
}
if (MAXARG)
count = POPi;
- EXTEND(SP, 7);
+ EXTEND(SP, 10);
for (;;) {
/* we may be in a higher stacklevel, so dig down deeper */
while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
else
PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
if (CxTYPE(cx) == CXt_EVAL) {
+ /* eval STRING */
if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
PUSHs(cx->blk_eval.cur_text);
PUSHs(&PL_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)));
+ }
+ /* require */
+ else if (cx->blk_eval.old_namesv) {
+ PUSHs(sv_2mortal(newSVsv(cx->blk_eval.old_namesv)));
PUSHs(&PL_sv_yes);
}
+ /* eval BLOCK (try blocks have old_namesv == 0) */
+ else {
+ PUSHs(&PL_sv_undef);
+ PUSHs(&PL_sv_undef);
+ }
}
else {
PUSHs(&PL_sv_undef);
* use the global PL_hints) */
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->op_private &
HINT_PRIVATE_MASK)));
+ {
+ SV * mask ;
+ SV * old_warnings = cx->blk_oldcop->cop_warnings ;
+ if (old_warnings == pWARN_NONE || old_warnings == pWARN_STD)
+ mask = newSVpvn(WARN_NONEstring, WARNsize) ;
+ else if (old_warnings == pWARN_ALL)
+ mask = newSVpvn(WARN_ALLstring, WARNsize) ;
+ else
+ mask = newSVsv(old_warnings);
+ PUSHs(sv_2mortal(mask));
+ }
RETURN;
}
if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
dPOPss;
if (SvNIOKp(sv) || !SvPOKp(sv) ||
- (looks_like_number(sv) && *SvPVX(sv) != '0')) {
+ SvNIOKp(cx->blk_loop.iterary) || !SvPOKp(cx->blk_loop.iterary) ||
+ (looks_like_number(sv) && *SvPVX(sv) != '0' &&
+ looks_like_number((SV*)cx->blk_loop.iterary) &&
+ *SvPVX(cx->blk_loop.iterary) != '0'))
+ {
if (SvNV(sv) < IV_MIN ||
SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
DIE(aTHX_ "Range iterator outside integer range");
I32 cxix;
register PERL_CONTEXT *cx;
bool popsub2 = FALSE;
+ bool clear_errsv = FALSE;
I32 gimme;
SV **newsp;
PMOP *newpm;
popsub2 = TRUE;
break;
case CXt_EVAL:
+ if (!(PL_in_eval & EVAL_KEEPERR))
+ clear_errsv = TRUE;
POPEVAL(cx);
+ if (CxTRYBLOCK(cx))
+ break;
if (AvFILLp(PL_comppad_name) >= 0)
free_closures();
lex_end();
(MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
{
/* Unassume the success we assumed earlier. */
- char *name = cx->blk_eval.old_name;
- (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD);
- DIE(aTHX_ "%s did not return a true value", name);
+ SV *nsv = cx->blk_eval.old_namesv;
+ (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD);
+ DIE(aTHX_ "%s did not return a true value", SvPVX(nsv));
}
break;
case CXt_FORMAT:
*++newsp = SvREFCNT_inc(*SP);
FREETMPS;
sv_2mortal(*newsp);
- } else {
+ }
+ else {
+ sv = SvREFCNT_inc(*SP); /* FREETMPS could clobber it */
FREETMPS;
- *++newsp = sv_mortalcopy(*SP);
+ *++newsp = sv_mortalcopy(sv);
+ SvREFCNT_dec(sv);
}
- } else
+ }
+ else
*++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
- } else
+ }
+ else
*++newsp = sv_mortalcopy(*SP);
- } else
+ }
+ else
*++newsp = &PL_sv_undef;
}
else if (gimme == G_ARRAY) {
LEAVE;
LEAVESUB(sv);
+ if (clear_errsv)
+ sv_setpv(ERRSV,"");
return pop_return();
}
{
I32 cxix;
register PERL_CONTEXT *cx;
- I32 oldsave;
+ I32 inner;
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < cxstack_ix)
dounwind(cxix);
+ /* clear off anything above the scope we're re-entering, but
+ * save the rest until after a possible continue block */
+ inner = PL_scopestack_ix;
TOPBLOCK(cx);
- oldsave = PL_scopestack[PL_scopestack_ix - 1];
- LEAVE_SCOPE(oldsave);
+ if (PL_scopestack_ix < inner)
+ leave_scope(PL_scopestack[PL_scopestack_ix]);
return cx->blk_loop.next_op;
}
(ops[-1]->op_type != OP_NEXTSTATE &&
ops[-1]->op_type != OP_DBSTATE)))
*ops++ = kid;
- if (o = dofindlabel(kid, label, ops, oplimit))
+ if ((o = dofindlabel(kid, label, ops, oplimit)))
return o;
}
}
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* av;
- int i;
#ifdef USE_THREADS
av = (AV*)PL_curpad[0];
#else
gotoprobe = PL_main_root;
break;
}
- retop = dofindlabel(gotoprobe, label,
- enterops, enterops + GOTO_DEPTH);
- if (retop)
- break;
+ if (gotoprobe) {
+ retop = dofindlabel(gotoprobe, label,
+ enterops, enterops + GOTO_DEPTH);
+ if (retop)
+ break;
+ }
PL_lastgotoprobe = gotoprobe;
}
if (!retop)
/* Eventually we may want to stack the needed arguments
* for each op. For now, we punt on the hard ones. */
if (PL_op->op_type == OP_ENTERITER)
- DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop",
- label);
+ DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
CALL_FPTR(PL_op->op_ppaddr)(aTHX);
}
PL_op = oldop;
anum = 0;
else {
anum = SvIVx(POPs);
-#ifdef VMSISH_EXIT
- if (anum == 1 && VMSISH_EXIT)
+#ifdef VMS
+ if (anum == 1 && (PL_op->op_private & OPpEXIT_VMSISH))
anum = 0;
#endif
}
}
}
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
STATIC void *
S_docatch_body(pTHX_ va_list args)
{
+ return docatch_body();
+}
+#endif
+
+STATIC void *
+S_docatch_body(pTHX)
+{
CALLRUNOPS(aTHX);
return NULL;
}
assert(CATCH_GET == TRUE);
#endif
PL_op = o;
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
+#else
+ JMPENV_PUSH(ret);
+#endif
switch (ret) {
case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+ docatch_body();
+#endif
break;
case 3:
if (PL_restartop && cursi == PL_curstackinfo) {
}
/* FALL THROUGH */
default:
+ JMPENV_POP;
PL_op = oldop;
JMPENV_JUMP(ret);
/* NOTREACHED */
}
+ JMPENV_POP;
PL_op = oldop;
return Nullop;
}
I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */
I32 optype;
OP dummy;
- OP *oop = PL_op, *rop;
- char tmpbuf[TYPE_DIGITS(long) + 12 + 10];
+ OP *rop;
+ char tbuf[TYPE_DIGITS(long) + 12 + 10];
+ char *tmpbuf = tbuf;
char *safestr;
ENTER;
}
SAVECOPFILE(&PL_compiling);
SAVECOPLINE(&PL_compiling);
- sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
+ if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
+ SV *sv = sv_newmortal();
+ Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]",
+ code, (unsigned long)++PL_evalseq,
+ CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
+ tmpbuf = SvPVX(sv);
+ }
+ else
+ sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
CopFILE_set(&PL_compiling, tmpbuf+2);
CopLINE_set(&PL_compiling, 1);
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
av_store(comppadlist, 1, (SV*)PL_comppad);
CvPADLIST(PL_compcv) = comppadlist;
- if (!saveop || saveop->op_type != OP_REQUIRE)
+ if (!saveop ||
+ (saveop->op_type != OP_REQUIRE && saveop->op_type != OP_DOFILE))
+ {
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller);
+ }
SAVEFREESV(PL_compcv);
SV *filter_sub = 0;
sv = POPs;
- if (SvNIOKp(sv) && !SvPOKp(sv)) {
- if (Atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
- DIE(aTHX_ "Perl %s required--this is only version %s, stopped",
- SvPV(sv,n_a),PL_patchlevel);
- RETPUSHYES;
+ if (SvNIOKp(sv)) {
+ if (SvPOK(sv) && SvNOK(sv)) { /* require v5.6.1 */
+ UV rev = 0, ver = 0, sver = 0;
+ I32 len;
+ U8 *s = (U8*)SvPVX(sv);
+ U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
+ if (s < end) {
+ rev = utf8_to_uv(s, &len);
+ s += len;
+ if (s < end) {
+ ver = utf8_to_uv(s, &len);
+ s += len;
+ if (s < end)
+ sver = utf8_to_uv(s, &len);
+ }
+ }
+ if (PERL_REVISION < rev
+ || (PERL_REVISION == rev
+ && (PERL_VERSION < ver
+ || (PERL_VERSION == ver
+ && PERL_SUBVERSION < sver))))
+ {
+ DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only "
+ "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION,
+ PERL_VERSION, PERL_SUBVERSION);
+ }
+ RETPUSHYES;
+ }
+ else if (!SvPOKp(sv)) { /* require 5.005_03 */
+ if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000)
+ + ((NV)PERL_SUBVERSION/(NV)1000000)
+ + 0.00000099 < SvNV(sv))
+ {
+ NV nrev = SvNV(sv);
+ UV rev = (UV)nrev;
+ NV nver = (nrev - rev) * 1000;
+ UV ver = (UV)(nver + 0.0009);
+ NV nsver = (nver - ver) * 1000;
+ UV sver = (UV)(nsver + 0.0009);
+
+ /* 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".%"UVuf".0?)",
+ rev, ver, sver, PERL_REVISION, PERL_VERSION,
+ PERL_SUBVERSION, rev, ver/100);
+ }
+ else {
+ DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--"
+ "this is only v%d.%d.%d, stopped",
+ rev, ver, sver, PERL_REVISION, PERL_VERSION,
+ PERL_SUBVERSION);
+ }
+ }
+ RETPUSHYES;
+ }
}
name = SvPV(sv, len);
if (!(name && len > 0 && *name))
PL_hints = 0;
SAVESPTR(PL_compiling.cop_warnings);
if (PL_dowarn & G_WARN_ALL_ON)
- PL_compiling.cop_warnings = WARN_ALL ;
+ PL_compiling.cop_warnings = pWARN_ALL ;
else if (PL_dowarn & G_WARN_ALL_OFF)
- PL_compiling.cop_warnings = WARN_NONE ;
+ PL_compiling.cop_warnings = pWARN_NONE ;
else
- PL_compiling.cop_warnings = WARN_STD ;
+ PL_compiling.cop_warnings = pWARN_STD ;
if (filter_sub || filter_child_proc) {
SV *datasv = filter_add(run_user_filter, Nullsv);
register PERL_CONTEXT *cx;
dPOPss;
I32 gimme = GIMME_V, was = PL_sub_generation;
- char tmpbuf[TYPE_DIGITS(long) + 12];
+ char tbuf[TYPE_DIGITS(long) + 12];
+ char *tmpbuf = tbuf;
char *safestr;
STRLEN len;
OP *ret;
/* switch to eval mode */
SAVECOPFILE(&PL_compiling);
- sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+ if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
+ SV *sv = sv_newmortal();
+ Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
+ (unsigned long)++PL_evalseq,
+ CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
+ tmpbuf = SvPVX(sv);
+ }
+ else
+ sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
CopFILE_set(&PL_compiling, tmpbuf+2);
CopLINE_set(&PL_compiling, 1);
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
{
/* Unassume the success we assumed earlier. */
- char *name = cx->blk_eval.old_name;
- (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD);
- retop = Perl_die(aTHX_ "%s did not return a true value", name);
+ SV *nsv = cx->blk_eval.old_namesv;
+ (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD);
+ retop = Perl_die(aTHX_ "%s did not return a true value", SvPVX(nsv));
/* die_where() did LEAVE, or we won't be here */
}
else {
SAVETMPS;
push_return(cLOGOP->op_other->op_next);
- PUSHBLOCK(cx, CXt_EVAL, SP);
+ PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP);
PUSHEVAL(cx, 0, 0);
PL_eval_root = PL_op; /* Only needed so that goto works right. */
on the correct side of the partition. If I find a greater
value, then stop the scan.
*/
- while (still_work_on_left = (u_right >= part_left)) {
+ while ((still_work_on_left = (u_right >= part_left))) {
s = qsort_cmp(u_right, pc_left);
if (s < 0) {
--u_right;
/* Do a mirror image scan of uncompared values on the right
*/
- while (still_work_on_right = (u_left <= part_right)) {
+ while ((still_work_on_right = (u_left <= part_right))) {
s = qsort_cmp(pc_right, u_left);
if (s < 0) {
++u_left;
https://perl5.git.perl.org / perl5.git / blobdiff