Integrate with Sarathy.

p4raw-id: //depot/cfgperl@6140

8 files changed, 188 insertions, 10 deletions

diff --git a/t/base/lex.t b/t/base/lex.t
index d90d404cac..c7fb0e4cf3 100755
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..46\n";
+print "1..51\n";
 
 $x = 'x';
 
@@ -206,3 +206,42 @@ 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;
+}
diff --git a/t/op/gv.t b/t/op/gv.t
index 04905cd400..209f5eb20b 100755
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -11,7 +11,7 @@ BEGIN {
 
 use warnings;
 
-print "1..30\n";
+print "1..40\n";
 
 # type coersion on assignment
 $foo = 'foo';
@@ -128,6 +128,42 @@ print {*x{FILEHANDLE}} "ok 23\n";
     ++$test; &{$a};
 }
 
+# although it *should* if you're talking about magicals
+
+{
+    my $test = 29;
+
+    my $a = "]";
+    print "not " unless defined ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+
+    $a = "1";
+    "o" =~ /(o)/;
+    print "not " unless ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+    $a = "2";
+    print "not " if ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+    $a = "1x";
+    print "not " if defined ${$a};
+    ++$test; print "ok $test\n";
+    print "not " if defined *{$a};
+    ++$test; print "ok $test\n";
+    $a = "11";
+    "o" =~ /(((((((((((o)))))))))))/;
+    print "not " unless ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+}
+
+
 # does pp_readline() handle glob-ness correctly?
 
 {
@@ -137,4 +173,4 @@ print {*x{FILEHANDLE}} "ok 23\n";
 }
 
 __END__
-ok 30
+ok 40
diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
index 836cdba4cc..f3f205e746 100755
--- a/t/op/lex_assign.t
+++ b/t/op/lex_assign.t
@@ -173,7 +173,7 @@ EOE
 __END__
 ref $xref			# ref
 ref $cstr			# ref nonref
-`$runme -e "print qq[1\n]"`				# backtick skip(MSWin32)
+`$runme -e "print qq[1\\n]"`				# backtick skip(MSWin32)
 `$undefed`			# backtick undef skip(MSWin32)
 <*>				# glob
 <OP>				# readline
diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars
index 2ccfef7105..5ba579d969 100644
--- a/t/pragma/strict-vars
+++ b/t/pragma/strict-vars
@@ -387,6 +387,8 @@ EXPECT
 # multiple our declarations in same scope, same package, warning
 use strict 'vars';
 use warnings;
+{ our $x = 1 }
+{ our $x = 0 }
 our $foo;
 {
     our $foo;
@@ -394,6 +396,17 @@ our $foo;
     our $foo;
 }
 EXPECT
-"our" variable $foo redeclared at - line 7.
+"our" variable $foo redeclared at - line 9.
 	(Did you mean "local" instead of "our"?)
-Name "Foo::foo" used only once: possible typo at - line 9.
+Name "Foo::foo" used only once: possible typo at - line 11.
+########
+
+# Make sure the strict vars failure still occurs
+# now that the `@i should be written as \@i' failure does not occur
+# 20000522 mjd@plover.com (MJD)
+use strict 'vars';
+no warnings;
+"@i_like_crackers";
+EXPECT
+Global symbol "@i_like_crackers" requires explicit package name at - line 7.
+Execution of - aborted due to compilation errors.
diff --git a/t/pragma/strict.t b/t/pragma/strict.t
index c4d64164e6..167b3604f5 100755
--- a/t/pragma/strict.t
+++ b/t/pragma/strict.t
@@ -19,7 +19,7 @@ my @prgs = () ;
 
 foreach (sort glob("pragma/strict-*")) {
 
-    next if /(~|\.orig)$/;
+    next if /(~|\.orig|,v)$/;
 
     open F, "<$_" or die "Cannot open $_: $!\n" ;
     while (<F>) {
diff --git a/t/pragma/warn/9enabled b/t/pragma/warn/9enabled
index 55642ffadf..96f319e55d 100755
--- a/t/pragma/warn/9enabled
+++ b/t/pragma/warn/9enabled
@@ -817,3 +817,87 @@ abc all not enabled
 def self enabled
 def abc not enabled
 def all not enabled
+########
+-w
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+-w
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+BEGIN { $^W = 1 ; }
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+$^W = 1 ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke
index 8db8027767..64f5368588 100644
--- a/t/pragma/warn/toke
+++ b/t/pragma/warn/toke
@@ -585,3 +585,11 @@ EXPECT
 Integer overflow in binary number at - line 5.
 Integer overflow in hexadecimal number at - line 8.
 Integer overflow in octal number at - line 11.
+########
+# toke.c
+use warnings 'ambiguous';
+"@mjd_previously_unused_array";        
+no warnings 'ambiguous';
+"@mjd_previously_unused_array";        
+EXPECT
+Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3.
diff --git a/t/pragma/warnings.t b/t/pragma/warnings.t
index 71fb0df972..a551740b17 100644
--- a/t/pragma/warnings.t
+++ b/t/pragma/warnings.t
@@ -26,9 +26,7 @@ else
 
 foreach (@w_files) {
 
-    next if /\.orig$/ ;
-
-    next if /(~|\.orig)$/;
+    next if /(~|\.orig|,v)$/;
 
     open F, "<$_" or die "Cannot open $_: $!\n" ;
     while (<F>) {