Avoid potentially empty struct.

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

diff --git a/t/op/eval.t b/t/op/eval.t
index 5822797..17b8d9d 100755 (executable)
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..30\n";
+print "1..45\n";
 
 eval 'print "ok 1\n";';
 
@@ -37,7 +37,7 @@ open(try,'>Op.eval');
 print try 'print "ok 10\n"; unlink "Op.eval";',"\n";
 close try;
 
-do 'Op.eval'; print $@;
+do './Op.eval'; print $@;
 
 # Test the singlequoted eval optimizer
 
@@ -90,15 +90,46 @@ my $X = sub {
 
 my $x = 25;
 eval <<'EOT'; die if $@;
-  sub do_eval {
+  print "# $x\n";      # clone into eval's pad
+  sub do_eval1 {
      eval $_[0]; die if $@;
   }
 EOT
-do_eval('print "ok $x\n"');
+do_eval1('print "ok $x\n"');
 $x++;
-do_eval('eval q[print "ok $x\n"]');
+do_eval1('eval q[print "ok $x\n"]');
 $x++;
-do_eval('sub { eval q[print "ok $x\n"] }->()');
+do_eval1('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()');
+$x++;
+
+# calls from within eval'' should clone outer lexicals
+
+eval <<'EOT'; die if $@;
+  sub do_eval2 {
+     eval $_[0]; die if $@;
+  }
+do_eval2('print "ok $x\n"');
+$x++;
+do_eval2('eval q[print "ok $x\n"]');
+$x++;
+do_eval2('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()');
+$x++;
+EOT
+
+# calls outside eval'' should NOT clone lexicals from called context
+
+$main::x = 'ok';
+eval <<'EOT'; die if $@;
+  # $x unbound here
+  sub do_eval3 {
+     eval $_[0]; die if $@;
+  }
+EOT
+do_eval3('print "$x ' . $x . '\n"');
+$x++;
+do_eval3('eval q[print "$x ' . $x . '\n"]');
+$x++;
+do_eval3('sub { eval q[print "$x ' . $x . '\n"] }->()');
 $x++;
 
 # can recursive subroutine-call inside eval'' see its own lexicals?
@@ -140,3 +171,66 @@ sub terminal { eval 'print $r' }
 }
 $x++;
 
+# Have we cured panic which occurred with require/eval in die handler ?
+$SIG{__DIE__} = sub { eval {1}; die shift }; 
+eval { die "ok ".$x++,"\n" }; 
+print $@;
+
+# does scalar eval"" pop stack correctly?
+{
+    my $c = eval "(1,2)x10";
+    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++;
+}
+
+# Check that eval catches bad goto calls
+#   (BUG ID 20010305.003)
+{
+    eval {
+       eval { goto foo; };
+       print ($@ ? "ok 41\n" : "not ok 41\n");
+       last;
+       foreach my $i (1) {
+           foo: print "not ok 41\n";
+           print "# jumped into foreach\n";
+       }
+    };
+    print "not ok 41\n" if $@;
+}
+
+# Make sure that "my $$x" is forbidden
+# 20011224 MJD
+{
+  eval q{my $$x};
+  print $@ ? "ok 42\n" : "not ok 42\n";
+  eval q{my @$x};
+  print $@ ? "ok 43\n" : "not ok 43\n";
+  eval q{my %$x};
+  print $@ ? "ok 44\n" : "not ok 44\n";
+  eval q{my $$$x};
+  print $@ ? "ok 45\n" : "not ok 45\n";
+}