diff options
Diffstat (limited to 'gnu/usr.bin/perl/t/op/eval.t')
-rw-r--r-- | gnu/usr.bin/perl/t/op/eval.t | 79 |
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++; +} |