summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/t/op/eval.t
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/perl/t/op/eval.t')
-rw-r--r--gnu/usr.bin/perl/t/op/eval.t79
1 files changed, 75 insertions, 4 deletions
diff --git a/gnu/usr.bin/perl/t/op/eval.t b/gnu/usr.bin/perl/t/op/eval.t
index 2eb9b1e9edd..071b2fa05ce 100644
--- a/gnu/usr.bin/perl/t/op/eval.t
+++ b/gnu/usr.bin/perl/t/op/eval.t
@@ -3,9 +3,10 @@
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ require './test.pl';
}
-print "1..95\n";
+print "1..99\n";
eval 'print "ok 1\n";';
@@ -38,11 +39,12 @@ $fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);';
$ans = eval $fact;
if ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
-open(try,'>Op.eval');
-print try 'print "ok 10\n"; unlink "Op.eval";',"\n";
+my $tempfile = tempfile();
+open(try,'>',$tempfile);
+print try 'print "ok 10\n";',"\n";
close try;
-do './Op.eval'; print $@;
+do "./$tempfile"; print $@;
# Test the singlequoted eval optimizer
@@ -485,4 +487,73 @@ print "ok $test - eval and last\n"; $test++;
}
+# [perl #51370] eval { die "\x{a10d}" } followed by eval { 1 } did not reset
+# length $@
+$@ = "";
+eval { die "\x{a10d}"; };
+$_ = length $@;
+eval { 1 };
+
+print "not " if ($@ ne "");
+print "ok $test # length of \$@ after eval\n"; $test++;
+
+print "not " if (length $@ != 0);
+print "ok $test # length of \$@ after eval\n"; $test++;
+
+# Check if eval { 1 }; compeltly resets $@
+if (eval "use Devel::Peek; 1;") {
+ $tempfile = tempfile();
+ $outfile = tempfile();
+ open PROG, ">", $tempfile or die "Can't create test file";
+ my $prog = <<'END_EVAL_TEST';
+ use Devel::Peek;
+ $! = 0;
+ $@ = $!;
+ my $ok = 0;
+ open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
+ if (open(OUT, '>', '@@@@')) {
+ open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
+ Dump($@);
+ print STDERR "******\n";
+ eval { die "\x{a10d}"; };
+ $_ = length $@;
+ eval { 1 };
+ Dump($@);
+ open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
+ close(OUT);
+ if (open(IN, '<', '@@@@')) {
+ local $/;
+ my $in = <IN>;
+ my ($first, $second) = split (/\*\*\*\*\*\*\n/, $in, 2);
+ $first =~ s/,pNOK//;
+ $ok = 1 if ($first eq $second);
+ }
+ }
+
+ print $ok;
+END_EVAL_TEST
+ $prog =~ s/\@\@\@\@/$outfile/g;
+ print PROG $prog;
+ close PROG;
+ my $ok = runperl(progfile => $tempfile);
+ print "not " unless $ok;
+ print "ok $test # eval { 1 } completly resets \$@\n";
+}
+else {
+ print "ok $test # skipped - eval { 1 } completly resets \$@\n";
+}
+$test++;
+
+# Test that "use feature" and other hint transmission in evals and s///ee
+# don't leak memory
+{
+ use feature qw(:5.10);
+ my $count_expected = ($^H & 0x20000) ? 2 : 1;
+ my $t;
+ my $s = "a";
+ $s =~ s/a/$t = \%^H; qq( qq() );/ee;
+ print "not " if Internals::SvREFCNT(%$t) != $count_expected;
+ print "ok $test - RT 63110\n";
+ $test++;
+}