allow boolean assign ops to be lvalues

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

diff --git a/t/op/eval.t b/t/op/eval.t
index 6d0a67b..498c63a 100755 (executable)
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -1,8 +1,6 @@
 #!./perl
 
-# $RCSfile: eval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:48 $
-
-print "1..16\n";
+print "1..29\n";
 
 eval 'print "ok 1\n";';
 
@@ -54,4 +52,80 @@ eval {
     1;
 } || print "ok 15\n$@";
 
+# check whether eval EXPR determines value of EXPR correctly
+
+{
+  my @a = qw(a b c d);
+  my @b = eval @a;
+  print "@b" eq '4' ? "ok 17\n" : "not ok 17\n";
+  print $@ ? "not ok 18\n" : "ok 18\n";
+
+  my $a = q[defined(wantarray) ? (wantarray ? ($b='A') : ($b='S')) : ($b='V')];
+  my $b;
+  @a = eval $a;
+  print "@a" eq 'A' ? "ok 19\n" : "# $b\nnot ok 19\n";
+  print   $b eq 'A' ? "ok 20\n" : "# $b\nnot ok 20\n";
+  $_ = eval $a;
+  print   $b eq 'S' ? "ok 21\n" : "# $b\nnot ok 21\n";
+  eval $a;
+  print   $b eq 'V' ? "ok 22\n" : "# $b\nnot ok 22\n";
+
+  $b = 'wrong';
+  $x = sub {
+     my $b = "right";
+     print eval('"$b"') eq $b ? "ok 23\n" : "not ok 23\n";
+  };
+  &$x();
+}
 
+my $b = 'wrong';
+my $X = sub {
+   my $b = "right";
+   print eval('"$b"') eq $b ? "ok 24\n" : "not ok 24\n";
+};
+&$X();
+
+
+# check navigation of multiple eval boundaries to find lexicals
+
+my $x = 25;
+eval <<'EOT'; die if $@;
+  sub do_eval {
+     eval $_[0]; die if $@;
+  }
+EOT
+do_eval('print "ok $x\n"');
+$x++;
+do_eval('eval q[print "ok $x\n"]');
+$x++;
+do_eval('sub { eval q[print "ok $x\n"] }->()');
+$x++;
+
+# can recursive subroutine-call inside eval'' see its own lexicals?
+sub recurse {
+  my $l = shift;
+  if ($l < $x) {
+     ++$l;
+     eval 'print "# level $l\n"; recurse($l);';
+     die if $@;
+  }
+  else {
+    print "ok $l\n";
+  }
+}
+{
+  local $SIG{__WARN__} = sub { die "not ok $x\n" if $_[0] =~ /^Deep recurs/ };
+  recurse($x-5);
+}
+$x++;
+
+# do closures created within eval bind correctly?
+eval <<'EOT';
+  sub create_closure {
+    my $self = shift;
+    return sub {
+       print $self;
+    };
+  }
+EOT
+create_closure("ok $x\n")->();