further fix for RT #23810

The fix for #23810, 27e904532594b7fb, introduced a regression, spotted by
Nicholas as RT #75146.

Basically, in S_doeval() if the yyparse() fails due to dying (rather than
just bailing out with with a syntax error, say), then the topmost EVAL
context will have been popped. My improved error handling code mostly
understood the difference, but forgot that in the die case, PL_eval_root
will have been restored to its previous value by the CX pop, and thus
its value shouldn't be messed with.

diff --git a/pp_ctl.c b/pp_ctl.c
index 37a585c..d203960 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3139,12 +3139,14 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        PERL_UNUSED_VAR(newsp);
        PERL_UNUSED_VAR(optype);
 
+       /* note that if yystatus == 3, then the EVAL CX block has already
+        * been popped, and various vars restored */
        PL_op = saveop;
-       if (PL_eval_root) {
-           op_free(PL_eval_root);
-           PL_eval_root = NULL;
-       }
        if (yystatus != 3) {
+           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);

diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t
index f22e170..2019d9b 100644 (file)
--- a/t/run/fresh_perl.t
+++ b/t/run/fresh_perl.t
@@ -857,3 +857,43 @@ $@ =~ s/ at .*/ at/;
 print $@
 EXPECT
 Malformed UTF-8 character (unexpected end of string) in substitution (s///) at
+######## "#75146: 27e904532594b7fb (fix for #23810) introduces a #regression"
+use strict;
+
+unshift @INC, sub {
+    my ($self, $fn) = @_;
+
+    (my $pkg = $fn) =~ s{/}{::}g;
+    $pkg =~ s{.pm$}{};
+
+    if ($pkg eq 'Credit') {
+        my $code = <<'EOC';
+package Credit;
+
+use NonsenseAndBalderdash;
+
+1;
+EOC
+        eval $code;
+        die "\$@ is $@";
+    }
+
+    #print STDERR "Generator: not one of mine, ignoring\n";
+    return undef;
+};
+
+# create load-on-demand new() constructors
+{
+    package Credit;
+    sub new {
+        eval "use Credit";
+    }
+};
+
+eval {
+    my $credit = new Credit;
+};
+
+print "If you get here, you didn't crash\n";
+EXPECT
+If you get here, you didn't crash