Update Changes.

[p5sagit/p5-mst-13.2.git] / t / base / lex.t

diff --git a/t/base/lex.t b/t/base/lex.t
index 6bb39d0..c7fb0e4 100755 (executable)
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,8 +1,6 @@
 #!./perl
 
-# $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
-
-print "1..41\n";
+print "1..51\n";
 
 $x = 'x';
 
@@ -155,6 +153,7 @@ print $foo;
   # These next two tests are trying to make sure that
   # $^FOO is always global; it doesn't make sense to `my' it.
   # 
+
   eval 'my $^X;';
   print "not " unless index ($@, 'Can\'t use global $^X in "my"') > -1;
   print "ok 37\n";
@@ -181,4 +180,68 @@ print $foo;
   
 }
 
+# see if eval '', s///e, and heredocs mix
+
+sub T {
+    my ($where, $num) = @_;
+    my ($p,$f,$l) = caller;
+    print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/;
+    print "ok $num\n";
+}
 
+my $test = 42;
+
+{
+# line 42 "plink"
+    local $_ = "not ok ";
+    eval q{
+       s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++;
+# fuggedaboudit
+EOT
+        print $_, $test++, "\n";
+       T('^main:\(eval \d+\):6$', $test++);
+# line 1 "plunk"
+       T('^main:plunk:1$', $test++);
+    };
+    print "# $@\nnot ok $test\n" if $@;
+    T '^main:plink:53$', $test++;
+}
+
+# tests 47--51 start here
+# tests for new array interpolation semantics:
+# arrays now *always* interpolate into "..." strings.
+# 20000522 MJD (mjd@plover.com)
+{
+  my $test = 47;
+  eval(q(">@nosuch<" eq "><")) || print "# $@", "not ";
+  print "ok $test\n";
+  ++$test;
+
+  # Look at this!  This is going to be a common error in the future:
+  eval(q("fred@example.com" eq "fred.com")) || print "# $@", "not ";
+  print "ok $test\n";
+  ++$test;
+
+  # Let's make sure that normal array interpolation still works right
+  # For some reason, this appears not to be tested anywhere else.
+  my @a = (1,2,3);
+  print +((">@a<" eq ">1 2 3<") ? '' : 'not '), "ok $test\n";
+  ++$test;
+
+  # Ditto.
+  eval(q{@nosuch = ('a', 'b', 'c'); ">@nosuch<" eq ">a b c<"}) 
+      || print "# $@", "not ";
+  print "ok $test\n";
+  ++$test;
+
+  # This isn't actually a lex test, but it's testing the same feature
+  sub makearray {
+    my @array = ('fish', 'dog', 'carrot');
+    *R::crackers = \@array;
+  }
+
+  eval(q{makearray(); ">@R::crackers<" eq ">fish dog carrot<"})
+    || print "# $@", "not ";
+  print "ok $test\n";
+  ++$test;
+}