From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 11 Mar 2000 18:40:49 +0000 (+0000)
Subject: another long-standing eval bug: return doesn't reset $@ correctly
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b45de488d87a3fe293c21579bc4d11fe89c10fb3;p=p5sagit%2Fp5-mst-13.2.git

another long-standing eval bug: return doesn't reset $@ correctly

p4raw-id: //depot/perl@5660
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 533a7c3..991af23 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1784,6 +1784,7 @@ PP(pp_return)
     I32 cxix;
     register PERL_CONTEXT *cx;
     bool popsub2 = FALSE;
+    bool clear_errsv = FALSE;
     I32 gimme;
     SV **newsp;
     PMOP *newpm;
@@ -1814,6 +1815,8 @@ PP(pp_return)
 	popsub2 = TRUE;
 	break;
     case CXt_EVAL:
+	if (!(PL_in_eval & EVAL_KEEPERR))
+	    clear_errsv = TRUE;
 	POPEVAL(cx);
 	if (CxTRYBLOCK(cx))
 	    break;
@@ -1875,6 +1878,8 @@ PP(pp_return)
 
     LEAVE;
     LEAVESUB(sv);
+    if (clear_errsv)
+	sv_setpv(ERRSV,"");
     return pop_return();
 }
 
diff --git a/t/op/eval.t b/t/op/eval.t
index ea6caf4..1838923 100755
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..38\n";
+print "1..40\n";
 
 eval 'print "ok 1\n";';
 
@@ -182,3 +182,27 @@ print $@;
     print $c eq '2222222222' ? "ok $x\n" : "# $c\nnot ok $x\n";
     $x++;
 }
+
+# return from eval {} should clear $@ correctly
+{
+    my $status = eval {
+	eval { die };
+	print "# eval { return } test\n";
+	return; # removing this changes behavior
+    };
+    print "not " if $@;
+    print "ok $x\n";
+    $x++;
+}
+
+# ditto for eval ""
+{
+    my $status = eval q{
+	eval q{ die };
+	print "# eval q{ return } test\n";
+	return; # removing this changes behavior
+    };
+    print "not " if $@;
+    print "ok $x\n";
+    $x++;
+}