Implement new regex escape \N

[p5sagit/p5-mst-13.2.git] / t / op / eval.t

diff --git a/t/op/eval.t b/t/op/eval.t
old mode 100755 (executable)
new mode 100644 (file)
index 57e39dd..071b2fa
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -3,9 +3,10 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-print "1..94\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
 
@@ -455,7 +457,14 @@ print "ok $test - eval and last\n"; $test++;
     local $@ = "foo";
     eval undef;
     print "not " unless $@ eq "";
-    print "ok $test # eval unef \n"; $test++;
+    print "ok $test # eval undef \n"; $test++;
+}
+
+{
+    no warnings;
+    eval "/ /a;";
+    print "not " unless $@ =~ /^syntax error/;
+    print "ok $test # eval syntax error, no warnings \n"; $test++;
 }
 
 
@@ -478,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++;
+}