Change 33177 by [EMAIL PROTECTED] on 2008/02/01 21:32:02
Integrate:
[ 31582]
Fix assertion failure on failed magic eval - eg FETCH {eval'('}
S_doeval()'s behaviour varies depending on whether the code
compiles or not; on failure it pops the EVAL context block. This
is bad because later on, S_docatch() assumes that the block is
still there. Make docatch() return a boolean instead, indicating
success. The value it formerly returned (the next op) can be deduced
as PL_eval_start or PL_op->op_next on success/failure.
[ 31586]
Use Perl_croak() rather than DIE() in S_doeval() because "DIE()"
becomes "return Perl_die()" and Perl_die() returns an OP*, which
isn't appropriate to return from S_doeval.
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#238 integrate
... //depot/maint-5.8/perl/pp_ctl.c#183 integrate
... //depot/maint-5.8/perl/proto.h#228 integrate
... //depot/maint-5.8/perl/t/op/eval.t#10 integrate
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#238 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#237~33168~ 2008-02-01 08:10:22.000000000 -0800
+++ perl/embed.fnc 2008-02-01 13:32:02.000000000 -0800
@@ -1246,7 +1246,7 @@
sR |I32 |dopoptoloop |I32 startingblock
sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock
s |void |save_lines |NULLOK AV *array|NN SV *sv
-sR |OP* |doeval |int gimme|NULLOK OP** startop|NULLOK CV*
outside|U32 seq
+s |bool |doeval |int gimme|NULLOK OP** startop|NULLOK CV*
outside|U32 seq
sR |PerlIO *|check_type_and_open|NN const char *name
#ifndef PERL_DISABLE_PMC
sR |PerlIO *|doopen_pm |NN const char *name|const STRLEN namelen
==== //depot/maint-5.8/perl/pp_ctl.c#183 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#182~32384~ 2007-11-17 14:34:52.000000000 -0800
+++ perl/pp_ctl.c 2008-02-01 13:32:02.000000000 -0800
@@ -2628,7 +2628,6 @@
I32 gimme = G_VOID;
I32 optype;
OP dummy;
- OP *rop;
char tbuf[TYPE_DIGITS(long) + 12 + 10];
char *tmpbuf = tbuf;
char *safestr;
@@ -2686,9 +2685,9 @@
PUSHEVAL(cx, 0, NULL);
if (runtime)
- rop = doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
+ (void) doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
else
- rop = doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax);
+ (void) doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
@@ -2706,7 +2705,7 @@
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(optype);
- return rop;
+ return PL_eval_start;
}
@@ -2754,10 +2753,13 @@
* In the last case, startop is non-null, and contains the address of
* a pointer that should be set to the just-compiled code.
* outside is the lexically enclosing CV (if any) that invoked us.
+ * Returns a bool indicating whether the compile was successful; if so,
+ * PL_eval_start contains the first op of the compiled ocde; otherwise,
+ * pushes undef (also croaks if startop != NULL).
*/
/* With USE_5005THREADS, eval_owner must be held on entry to doeval */
-STATIC OP *
+STATIC bool
S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
{
dSP;
@@ -2836,8 +2838,8 @@
msg = SvPVx_nolen_const(ERRSV);
if (optype == OP_REQUIRE) {
const char* const msg = SvPVx_nolen_const(ERRSV);
- DIE(aTHX_ "%sCompilation failed in require",
- *msg ? msg : "Unknown error\n");
+ Perl_croak(aTHX_ "%sCompilation failed in require",
+ *msg ? msg : "Unknown error\n");
}
else if (startop) {
POPBLOCK(cx,PL_curpm);
@@ -2857,7 +2859,9 @@
MUTEX_UNLOCK(&PL_eval_mutex);
#endif /* USE_5005THREADS */
PERL_UNUSED_VAR(newsp);
- RETPUSHUNDEF;
+ PUSHs(&PL_sv_undef);
+ PUTBACK;
+ return FALSE;
}
CopLINE_set(&PL_compiling, 0);
if (startop) {
@@ -2907,7 +2911,8 @@
MUTEX_UNLOCK(&PL_eval_mutex);
#endif /* USE_5005THREADS */
- RETURNOP(PL_eval_start);
+ PUTBACK;
+ return TRUE;
}
STATIC PerlIO *
@@ -3417,7 +3422,10 @@
encoding = PL_encoding;
PL_encoding = NULL;
- op = DOCATCH(doeval(gimme, NULL, Nullcv, PL_curcop->cop_seq));
+ if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq))
+ op = DOCATCH(PL_eval_start);
+ else
+ op = PL_op->op_next;
/* Restore encoding. */
PL_encoding = encoding;
@@ -3436,7 +3444,7 @@
char *tmpbuf = tbuf;
char *safestr;
STRLEN len;
- OP *ret;
+ bool ok;
CV* runcv;
U32 seq;
const char * const fakestr = "_<(eval )";
@@ -3512,13 +3520,13 @@
PL_eval_owner = thr;
MUTEX_UNLOCK(&PL_eval_mutex);
#endif /* USE_5005THREADS */
- ret = doeval(gimme, NULL, runcv, seq);
+ ok = doeval(gimme, NULL, runcv, seq);
if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined
here. */
- && ret != PL_op->op_next) { /* Successive compilation. */
+ && ok) {
/* Copy in anything fake and short. */
my_strlcpy(safestr, fakestr, fakelen);
}
- return DOCATCH(ret);
+ return ok ? DOCATCH(PL_eval_start) : PL_op->op_next;
}
PP(pp_leaveeval)
==== //depot/maint-5.8/perl/proto.h#228 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#227~33168~ 2008-02-01 08:10:22.000000000 -0800
+++ perl/proto.h 2008-02-01 13:32:02.000000000 -0800
@@ -1785,9 +1785,7 @@
__attribute__warn_unused_result__;
STATIC void S_save_lines(pTHX_ AV *array, SV *sv);
-STATIC OP* S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
- __attribute__warn_unused_result__;
-
+STATIC bool S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq);
STATIC PerlIO * S_check_type_and_open(pTHX_ const char *name)
__attribute__warn_unused_result__;
==== //depot/maint-5.8/perl/t/op/eval.t#10 (xtext) ====
Index: perl/t/op/eval.t
--- perl/t/op/eval.t#9~32394~ 2007-11-18 14:16:34.000000000 -0800
+++ perl/t/op/eval.t 2008-02-01 13:32:02.000000000 -0800
@@ -5,7 +5,7 @@
@INC = '../lib';
}
-print "1..94\n";
+print "1..95\n";
eval 'print "ok 1\n";';
@@ -465,3 +465,24 @@
print "ok $test # eval syntax error, no warnings \n"; $test++;
}
+
+# a syntax error in an eval called magically 9eg vie tie or overload)
+# resulted in an assertion failure in S_docatch, since doeval had already
+# poppedthe EVAL context due to the failure, but S_docatch expected the
+# context to still be there.
+
+{
+ my $ok = 0;
+ package Eval1;
+ sub STORE { eval '('; $ok = 1 }
+ sub TIESCALAR { bless [] }
+
+ my $x;
+ tie $x, bless [];
+ $x = 1;
+ print "not " unless $ok;
+ print "ok $test # eval docatch \n"; $test++;
+}
+
+
+
End of Patch.
