A shot in the dark.

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

diff --git a/t/base/lex.t b/t/base/lex.t
index d90d404..4166c18 100755 (executable)
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..46\n";
+print "1..54\n";
 
 $x = 'x';
 
@@ -53,8 +53,8 @@ $foo
 EOF
 EOE
 
-print <<`EOS` . <<\EOF;
-echo ok 12
+print <<'EOS' . <<\EOF;
+ok 12 - make sure single quotes are honored \nnot ok
 EOS
 ok 13
 EOF
@@ -130,10 +130,10 @@ print $foo;
   if (eval "\$ {\cX}" != 17 or $@) { print "not "  }
   print "ok 32\n";
 
-  eval "\$\cN = 24";                 # Literal control character
-  if ($@ or ${"\cN"} != 24) {  print "not "  }
+  eval "\$\cQ = 24";                 # Literal control character
+  if ($@ or ${"\cQ"} != 24) {  print "not "  }
   print "ok 33\n";
-  if ($^N != 24) {  print "not "  }  # Control character escape sequence
+  if ($^Q != 24) {  print "not "  }  # Control character escape sequence
   print "ok 34\n";
 
 # Does the old UNBRACED syntax still do what it used to?
@@ -141,11 +141,11 @@ print $foo;
   print "ok 35\n";
 
   sub XX () { 6 }
-  $ {"\cN\cXX"} = 119; 
-  $^N = 5; #  This should be an unused ^Var.
+  $ {"\cQ\cXX"} = 119; 
+  $^Q = 5; #  This should be an unused ^Var.
   $N = 5;
   # The second caret here should be interpreted as an xor
-  if (($^N^XX) != 3) { print "not " } 
+  if (($^Q^XX) != 3) { print "not " } 
   print "ok 36\n";
 #  if (($N  ^  XX()) != 3) { print "not " } 
 #  print "ok 32\n";
@@ -166,13 +166,13 @@ print $foo;
 
 # Now let's make sure that caret variables are all forced into the main package.
   package Someother;
-  $^N = 'Someother';
-  $ {^Nostril} = 'Someother 2';
+  $^Q = 'Someother';
+  $ {^Quixote} = 'Someother 2';
   $ {^M} = 'Someother 3';
   package main;
-  print "not " unless $^N eq 'Someother';
+  print "not " unless $^Q eq 'Someother';
   print "ok 39\n";
-  print "not " unless $ {^Nostril} eq 'Someother 2';
+  print "not " unless $ {^Quixote} eq 'Someother 2';
   print "ok 40\n";
   print "not " unless $ {^M} eq 'Someother 3';
   print "ok 41\n";
@@ -206,3 +206,57 @@ EOT
     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;
+}
+
+# Tests 52-54
+# => should only quote foo::bar if it isn't a real sub. AMS, 20010621
+
+sub xyz::foo { "bar" }
+my %str = (
+    foo      => 1,
+    xyz::foo => 1,
+    xyz::bar => 1,
+);
+
+my $test = 52;
+print ((exists $str{foo}      ? "" : "not ")."ok $test\n"); ++$test;
+print ((exists $str{bar}      ? "" : "not ")."ok $test\n"); ++$test;
+print ((exists $str{xyz::bar} ? "" : "not ")."ok $test\n"); ++$test;