[win32] integrate mainline changes

p4raw-id: //depot/asperl@799

11 files changed, 112 insertions, 38 deletions

diff --git a/t/base/lex.t b/t/base/lex.t
index 6d03b9e8df..31bb056b5b 100755
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
 
-print "1..27\n";
+print "1..28\n";
 
 $x = 'x';
 
@@ -105,3 +105,9 @@ print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
 print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
 
 print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 27\n" : "not ok 27\n");
+
+$foo = "not ok 28\n";
+$foo =~ s/^not /substr(<<EOF, 0, 0)/e;
+  Ignored
+EOF
+print $foo;
diff --git a/t/cmd/mod.t b/t/cmd/mod.t
index b4f2731ffa..e2ab777246 100755
--- a/t/cmd/mod.t
+++ b/t/cmd/mod.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: mod.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:11 $
 
-print "1..11\n";
+print "1..12\n";
 
 print "ok 1\n" if 1;
 print "not ok 1\n" unless 1;
@@ -27,21 +27,28 @@ $x = 15;
 $x = 10 while $x < 10;
 if ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
 
+$y[$_] = $_ * 2 foreach @x;
+if (join(' ',@y) eq '0 2 4 6 8 10 12 14 16 18 20') {
+	print "ok 7\n";
+} else {
+	print "not ok 7 @y\n";
+}
+
 open(foo,'./TEST') || open(foo,'TEST') || open(foo,'t/TEST');
 $x = 0;
 $x++ while <foo>;
-print $x > 50 && $x < 1000 ? "ok 7\n" : "not ok 7\n";
+print $x > 50 && $x < 1000 ? "ok 8\n" : "not ok 8\n";
 
 $x = -0.5;
 print "not " if scalar($x) < 0 and $x >= 0;
-print "ok 8\n";
+print "ok 9\n";
 
 print "not " unless (-(-$x) < 0) == ($x < 0);
-print "ok 9\n";
+print "ok 10\n";
 
-print "ok 10\n" if $x < 0;
-print "not ok 10\n" unless $x < 0;
+print "ok 11\n" if $x < 0;
+print "not ok 11\n" unless $x < 0;
 
-print "ok 11\n" unless $x > 0;
-print "not ok 11\n" if $x > 0;
+print "ok 12\n" unless $x > 0;
+print "not ok 12\n" if $x > 0;
 
diff --git a/t/op/local.t b/t/op/local.t
index a034539cae..0df1b6d1dc 100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
 
-print "1..25\n";
+print "1..36\n";
 
 sub foo {
     local($a, $b) = @_;
@@ -53,13 +53,46 @@ print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
 eval 'local(%$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";
 
+# Array and hash elements
+
+@a = ('a', 'b', 'c');
+{
+    local($a[1]) = 'foo';
+    local($a[2]) = $a[2];
+    print +($a[1] eq 'foo') ? "" : "not ", "ok 24\n";
+    print +($a[2] eq 'c') ? "" : "not ", "ok 25\n";
+    undef @a;
+}
+print +($a[1] eq 'b') ? "" : "not ", "ok 26\n";
+print +($a[2] eq 'c') ? "" : "not ", "ok 27\n";
+print +(!defined $a[0]) ? "" : "not ", "ok 28\n";
+
+@a = ('a', 'b', 'c');
+{
+    local($a[1]) = "X";
+    shift @a;
+}
+print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 29\n";
+
+%h = ('a' => 1, 'b' => 2, 'c' => 3);
+{
+    local($h{'a'}) = 'foo';
+    local($h{'b'}) = $h{'b'};
+    print +($h{'a'} eq 'foo') ? "" : "not ", "ok 30\n";
+    print +($h{'b'} == 2) ? "" : "not ", "ok 31\n";
+    local($h{'c'});
+    delete $h{'c'};
+}
+print +($h{'a'} == 1) ? "" : "not ", "ok 32\n";
+print +($h{'b'} == 2) ? "" : "not ", "ok 33\n";
+print +($h{'c'} == 3) ? "" : "not ", "ok 34\n";
+
 # check for scope leakage
 $a = 'outer';
 if (1) { local $a = 'inner' }
-print +($a eq 'outer') ? "" : "not ", "ok 24\n";
+print +($a eq 'outer') ? "" : "not ", "ok 35\n";
 
 # see if localization works when scope unwinds
-
 local $m = 5;
 eval {
     for $m (6) {
@@ -67,4 +100,4 @@ eval {
 	die "bye";
     }
 };
-print $m == 5 ? "" : "not ", "ok 25\n";
+print $m == 5 ? "" : "not ", "ok 36\n";
diff --git a/t/op/magic.t b/t/op/magic.t
index ab23d84cc5..ec7fbb529e 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -24,7 +24,7 @@ $Is_VMS     = $^O eq 'VMS';
 $Is_Dos   = $^O eq 'dos';
 $PERL = ($Is_MSWin32 ? '.\perl' : './perl');
 
-print "1..34\n";
+print "1..35\n";
 
 eval '$ENV{"FOO"} = "hi there";';	# check that ENV is inited inside eval
 if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; }
@@ -182,20 +182,26 @@ else {
 						: (`echo \$NoNeSuCh` eq "foo\n") );
 }
 
+{
+    local $SIG{'__WARN__'} = sub { print "not " };
+    $! = undef;
+    print "ok 31\n";
+}
+
 # test case-insignificance of %ENV (these tests must be enabled only
 # when perl is compiled with -DENV_IS_CASELESS)
 if ($Is_MSWin32) {
     %ENV = ();
     $ENV{'Foo'} = 'bar';
     $ENV{'fOo'} = 'baz';
-    ok 31, (scalar(keys(%ENV)) == 1);
-    ok 32, exists($ENV{'FOo'});
-    ok 33, (delete($ENV{'foO'}) eq 'baz');
-    ok 34, (scalar(keys(%ENV)) == 0);
+    ok 32, (scalar(keys(%ENV)) == 1);
+    ok 33, exists($ENV{'FOo'});
+    ok 34, (delete($ENV{'foO'}) eq 'baz');
+    ok 35, (scalar(keys(%ENV)) == 0);
 }
 else {
-    ok "31 # skipped",1;
     ok "32 # skipped",1;
     ok "33 # skipped",1;
     ok "34 # skipped",1;
+    ok "35 # skipped",1;
 }
diff --git a/t/op/misc.t b/t/op/misc.t
index 1ca45db039..40c9c38825 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -358,3 +358,13 @@ init <b>
 end <c>
 argv <>
 ########
+-l
+# fdopen from a system descriptor to a system descriptor used to close
+# the former.
+open STDERR, '>&=STDOUT' or die $!;
+select STDOUT; $| = 1; print fileno STDOUT;
+select STDERR; $| = 1; print fileno STDERR;
+EXPECT
+1
+2
+########
diff --git a/t/op/my.t b/t/op/my.t
index d439bebd86..1777e88266 100755
--- a/t/op/my.t
+++ b/t/op/my.t
@@ -10,7 +10,8 @@ sub foo {
     my $d;
     $c = "ok 3\n";
     $d = "ok 4\n";
-    { my($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); }
+    { my($a, undef, $c) = ("ok 9\n", "not ok 10\n", "ok 10\n");
+      ($x, $y) = ($a, $c); }
     print $a, $b;
     $c . $d;
 }
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 1450ae375f..7556c80a41 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -14,8 +14,8 @@ $SIG{__WARN__} = sub {
 };
 
 $w = 0;
-$x = sprintf("%3s %-4s%%foo %5d%c%3.1f","hi",123,456,65,3.0999);
-if ($x eq ' hi 123 %foo   456A3.1' && $w == 0) {
+$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,65,3.0999);
+if ($x eq ' hi 123 %foo   456 0A3.1' && $w == 0) {
     print "ok 1\n";
 } else {
     print "not ok 1 '$x'\n";
diff --git a/t/op/subst.t b/t/op/subst.t
index c6cfb8c96d..4fd00d5067 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $
 
-print "1..67\n";
+print "1..68\n";
 
 $x = 'foo';
 $_ = "x";
@@ -261,3 +261,9 @@ print $_ eq "foobarfoobbar" ? "ok 66\n" : "not ok 66 # `$_' ne `foobarfoobbar'\n
 eval 's{foo} # this is a comment, not a delimiter
        {bar};';
 print @? ? "not ok 67\n" : "ok 67\n";
+
+# check if squashing works at the end of string
+$_="baacbaa";
+tr/a/b/s;
+print $_ eq "bbcbb" ? "ok 68\n" : "not ok 68 # `$_' ne `bbcbb'\n";
+
diff --git a/t/pragma/strict-subs b/t/pragma/strict-subs
index 43fce712d5..61ec286eb6 100644
--- a/t/pragma/strict-subs
+++ b/t/pragma/strict-subs
@@ -81,7 +81,7 @@ use strict 'vars' ;
 $joe = 1 ;
 EXPECT
 Variable "$joe" is not imported at - line 8.
-Global symbol "joe" requires explicit package name at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -93,7 +93,7 @@ no strict;
 }
 $joe = 1 ;
 EXPECT
-Global symbol "joe" requires explicit package name at - line 6.
+Global symbol "$joe" requires explicit package name at - line 6.
 Execution of - aborted due to compilation errors.
 ########
 
diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars
index 7ca9843c2c..42107fa8e1 100644
--- a/t/pragma/strict-vars
+++ b/t/pragma/strict-vars
@@ -40,7 +40,7 @@ EXPECT
 use strict ;
 $fred ;
 EXPECT
-Global symbol "fred" requires explicit package name at - line 4.
+Global symbol "$fred" requires explicit package name at - line 4.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -48,7 +48,7 @@ Execution of - aborted due to compilation errors.
 use strict 'vars' ;
 $fred ;
 EXPECT
-Global symbol "fred" requires explicit package name at - line 4.
+Global symbol "$fred" requires explicit package name at - line 4.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -56,7 +56,7 @@ Execution of - aborted due to compilation errors.
 use strict 'vars' ;
 local $fred ;
 EXPECT
-Global symbol "fred" requires explicit package name at - line 4.
+Global symbol "$fred" requires explicit package name at - line 4.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -69,7 +69,7 @@ use strict 'vars' ;
 $joe = 1 ;
 EXPECT
 Variable "$joe" is not imported at - line 8.
-Global symbol "joe" requires explicit package name at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -81,7 +81,7 @@ no strict;
 }
 $joe = 1 ;
 EXPECT
-Global symbol "joe" requires explicit package name at - line 6.
+Global symbol "$joe" requires explicit package name at - line 6.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -114,7 +114,7 @@ $joe = 1 ;
 require "./abc";
 EXPECT
 Variable "$joe" is not imported at ./abc line 2.
-Global symbol "joe" requires explicit package name at ./abc line 2.
+Global symbol "$joe" requires explicit package name at ./abc line 2.
 Compilation failed in require at - line 2.
 ########
 
@@ -127,7 +127,7 @@ $joe = 1 ;
 use abc;
 EXPECT
 Variable "$joe" is not imported at abc.pm line 2.
-Global symbol "joe" requires explicit package name at abc.pm line 2.
+Global symbol "$joe" requires explicit package name at abc.pm line 2.
 Compilation failed in require at - line 2.
 BEGIN failed--compilation aborted at - line 2.
 ########
@@ -152,7 +152,7 @@ eval {
 print STDERR $@;
 $joe = 1 ;
 EXPECT
-Global symbol "joe" requires explicit package name at - line 6.
+Global symbol "$joe" requires explicit package name at - line 6.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -164,7 +164,7 @@ eval {
 print STDERR $@;
 $joe = 1 ;
 EXPECT
-Global symbol "joe" requires explicit package name at - line 5.
+Global symbol "$joe" requires explicit package name at - line 5.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -178,7 +178,7 @@ print STDERR $@;
 $joe = 1 ;
 EXPECT
 Variable "$joe" is not imported at - line 9.
-Global symbol "joe" requires explicit package name at - line 9.
+Global symbol "$joe" requires explicit package name at - line 9.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -199,7 +199,7 @@ eval q[
     $joe = 1 ;
 ]; print STDERR $@;
 EXPECT
-Global symbol "joe" requires explicit package name at (eval 1) line 3.
+Global symbol "$joe" requires explicit package name at (eval 1) line 3.
 ########
 
 # Check scope of pragma with eval
@@ -208,7 +208,7 @@ eval '
     $joe = 1 ;
 '; print STDERR $@ ;
 EXPECT
-Global symbol "joe" requires explicit package name at (eval 1) line 2.
+Global symbol "$joe" requires explicit package name at (eval 1) line 2.
 ########
 
 # Check scope of pragma with eval
@@ -219,5 +219,5 @@ eval '
 '; print STDERR $@;
 $joe = 1 ;
 EXPECT
-Global symbol "joe" requires explicit package name at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
 Execution of - aborted due to compilation errors.
diff --git a/t/pragma/warn-1global b/t/pragma/warn-1global
index 33252731b0..07b5bc8eb9 100644
--- a/t/pragma/warn-1global
+++ b/t/pragma/warn-1global
@@ -144,3 +144,8 @@ my $a ; chop $a ;
 my $c ; chop $c ;
 EXPECT
 Use of uninitialized value at - line 5.
+########
+-w
+-e undef
+EXPECT
+Use of uninitialized value at - line 2.