Skip to content

Commit

Permalink
fix RT 23810: eval and tied methods
Browse files Browse the repository at this point in the history 
Something like the following ended up corrupted:
    sub FETCH { eval 'BEGIN{syntax err}' }
The croak on error popped back the context stack etc to the EVAL pushed by
entereval, but the corresponding JUMPENV_PUSH(3) unwound all the way to the
outer perl_run, losing all the mg_get() related parts of the C stack.

It turns out that the run-time parts of pp_entereval were protected with
a new JUMPENV level, but the compile-time parts weren't. Add this.
  • Loading branch information
@iabyn
iabyn committed Apr 8, 2010
1 parent 91e35ba commit 27e9045
Show file tree
Hide file tree
Showing 2 changed files with 150 additions and 12 deletions.
72 changes: 60 additions & 12 deletions pp_ctl.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1653,6 +1653,10 @@ Perl_die_where(pTHX_ SV *msv)
SV * const nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
&PL_sv_undef, 0);
/* note that unlike pp_entereval, pp_require isn't
* supposed to trap errors. So now that we've popped the
* EVAL that pp_require pushed, and processed the error
* message, rethrow the error */
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
Expand Down Expand Up @@ -3041,6 +3045,35 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
}


/* Run yyparse() in a setjmp wrapper. Returns:
* 0: yyparse() successful
* 1: yyparse() failed
* 3: yyparse() died
*/
STATIC int
S_try_yyparse(pTHX)
{
int ret;
dJMPENV;

assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
JMPENV_PUSH(ret);
switch (ret) {
case 0:
ret = yyparse() ? 1 : 0;
break;
case 3:
break;
default:
JMPENV_POP;
JMPENV_JUMP(ret);
/* NOTREACHED */
}
JMPENV_POP;
return ret;
}


/* Compile a require/do, an eval '', or a /(?{...})/.
* In the last case, startop is non-null, and contains the address of
* a pointer that should be set to the just-compiled code.
Expand All @@ -3055,8 +3088,10 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
{
dVAR; dSP;
OP * const saveop = PL_op;
bool in_require = (saveop && saveop->op_type == OP_REQUIRE);
int yystatus;

PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
PL_in_eval = (in_require
? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
: EVAL_INEVAL);

Expand Down Expand Up @@ -3108,36 +3143,50 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
PL_in_eval |= EVAL_KEEPERR;
else
CLEAR_ERRSV();
if (yyparse() || PL_parser->error_count || !PL_eval_root) {

/* note that yyparse() may raise an exception, e.g. C<BEGIN{die}>,
* so honour CATCH_GET and trap it here if necessary */

yystatus = (!in_require && CATCH_GET) ? S_try_yyparse(aTHX) : yyparse();

if (yystatus || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
I32 optype = 0; /* Might be reset by POPEVAL. */
I32 optype; /* Used by POPEVAL. */
const char *msg;

PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(optype);

PL_op = saveop;
if (PL_eval_root) {
op_free(PL_eval_root);
PL_eval_root = NULL;
}
SP = PL_stack_base + POPMARK; /* pop original mark */
if (!startop) {
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
if (yystatus != 3) {
SP = PL_stack_base + POPMARK; /* pop original mark */
if (!startop) {
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
}
}
lex_end();
LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */
if (yystatus != 3)
LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */

msg = SvPVx_nolen_const(ERRSV);
if (optype == OP_REQUIRE) {
if (in_require) {
const SV * const nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
&PL_sv_undef, 0);
Perl_croak(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
else if (startop) {
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
if (yystatus != 3) {
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
}
Perl_croak(aTHX_ "%sCompilation failed in regexp",
(*msg ? msg : "Unknown error\n"));
}
Expand All @@ -3146,7 +3195,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
sv_setpvs(ERRSV, "Compilation error");
}
}
PERL_UNUSED_VAR(newsp);
PUSHs(&PL_sv_undef);
PUTBACK;
return FALSE;
Expand Down
90 changes: 90 additions & 0 deletions t/op/tie.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -658,3 +658,93 @@ sub STORE {
tie $SELECT, 'main';
$SELECT = *STDERR;
EXPECT
########
# RT 23810: eval in die in FETCH can corrupt context stack
my $file = 'rt23810.pm';
my $e;
my $s;
sub do_require {
my ($str, $eval) = @_;
open my $fh, '>', $file or die "Can't create $file: $!\n";
print $fh $str;
close $fh;
if ($eval) {
$s .= '-ERQ';
eval { require $pm; $s .= '-ENDE' }
}
else {
$s .= '-RQ';
require $pm;
}
$s .= '-ENDRQ';
unlink $file;
}
sub TIEHASH { bless {} }
sub FETCH {
# 10 or more syntax errors makes yyparse croak()
my $bad = q{$x+;$x+;$x+;$x+;$x+;$x+;$x+;$x+;$x+$x+;$x+;$x+;$x+;$x+;;$x+;};
if ($_[1] eq 'eval') {
$s .= 'EVAL';
eval q[BEGIN { die; $s .= '-X1' }];
$s .= '-BD';
eval q[BEGIN { $x+ }];
$s .= '-BS';
eval '$x+';
$s .= '-E1';
$s .= '-S1' while $@ =~ /syntax error at/g;
eval $bad;
$s .= '-E2';
$s .= '-S2' while $@ =~ /syntax error at/g;
}
elsif ($_[1] eq 'require') {
$s .= 'REQUIRE';
my @text = (
q[BEGIN { die; $s .= '-X1' }],
q[BEGIN { $x+ }],
'$x+',
$bad
);
for my $i (0..$#text) {
$s .= "-$i";
do_require($txt[$i], 0) if $e;;
do_require($txt[$i], 1);
}
}
elsif ($_[1] eq 'exit') {
eval q[exit(0); print "overshot eval\n"];
}
else {
print "unknown key: '$_[1]'\n";
}
return "-R";
}
my %foo;
tie %foo, "main";
for my $action(qw(eval require)) {
$s = ''; $e = 0; $s .= main->FETCH($action); print "$action: s0=$s\n";
$s = ''; $e = 1; eval { $s .= main->FETCH($action)}; print "$action: s1=$s\n";
$s = ''; $e = 0; $s .= $foo{$action}; print "$action: s2=$s\n";
$s = ''; $e = 1; eval { $s .= $foo{$action}}; print "$action: s3=$s\n";
}
1 while unlink $file;
$foo{'exit'};
print "overshot main\n"; # shouldn't reach here
EXPECT
eval: s0=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
eval: s1=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
eval: s2=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
eval: s3=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
require: s0=REQUIRE-0-ERQ-ENDRQ-1-ERQ-ENDRQ-2-ERQ-ENDRQ-3-ERQ-ENDRQ-R
require: s1=REQUIRE-0-RQ
require: s2=REQUIRE-0-ERQ-ENDRQ-1-ERQ-ENDRQ-2-ERQ-ENDRQ-3-ERQ-ENDRQ-R
require: s3=REQUIRE-0-RQ

0 comments on commit 27e9045

Please sign in to comment.