[win32] integrate mainline

p4raw-id: //depot/win32/perl@567

12 files changed, 57 insertions, 19 deletions

diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
index 854f146337..ce3003e5b7 100755
--- a/t/lib/anydbm.t
+++ b/t/lib/anydbm.t
@@ -85,7 +85,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -94,7 +94,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index fea0cd7fb7..2395611d1e 100755
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -87,7 +87,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -96,7 +96,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t
index db9846a8cb..a97dbd1f1e 100755
--- a/t/lib/ndbm.t
+++ b/t/lib/ndbm.t
@@ -90,7 +90,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/odbm.t b/t/lib/odbm.t
index 65c9870a02..8ba9bcf3a4 100755
--- a/t/lib/odbm.t
+++ b/t/lib/odbm.t
@@ -90,7 +90,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index 90dbb841e6..c2952ecf68 100755
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -90,7 +90,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/op/array.t b/t/op/array.t
index db70c3981f..f307655ced 100755
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: array.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:37 $
 
-print "1..39\n";
+print "1..40\n";
 
 @ary = (1,2,3,4,5);
 if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
@@ -144,3 +144,7 @@ eval {
 };
 print "not " unless $@ =~ /Can't multiply inherit %FIELDS/;
 print "ok 39\n";
+
+@foo = ( 'foo', 'bar', 'burbl');
+push(foo, 'blah');
+print $#foo == 3 ? "ok 40\n" : "not ok 40\n";
diff --git a/t/op/delete.t b/t/op/delete.t
index 4e00566cd7..6cc447506a 100755
--- a/t/op/delete.t
+++ b/t/op/delete.t
@@ -29,17 +29,17 @@ if ($foo{5} eq '') {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
 if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
 if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
 
-$foo = join('',values(foo));
+$foo = join('',values(%foo));
 if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";}
 
-foreach $key (keys foo) {
+foreach $key (keys %foo) {
     delete $foo{$key};
 }
 
 $foo{'foo'} = 'x';
 $foo{'bar'} = 'y';
 
-$foo = join('',values(foo));
+$foo = join('',values(%foo));
 print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n";
 
 $refhash{"top"}->{"foo"} = "FOO";
diff --git a/t/op/each.t b/t/op/each.t
index b92dd1770c..420fdc09c3 100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: each.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:47 $
 
-print "1..14\n";
+print "1..16\n";
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -107,3 +107,15 @@ print "ok 13\n";
 print "not " if keys(%hash) != 10;
 print "ok 14\n";
 
+print keys(hash) != 10 ? "not ok 15\n" : "ok 15\n";
+
+$i = 0;
+%h = (a => A, b => B, c=> C, d => D, abc => ABC);
+@keys = keys(h);
+@values = values(h);
+while (($key, $value) = each(h)) {
+	if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+		$i++;
+	}
+}
+if ($i == 5) { print "ok 16\n" } else { print "not ok\n" }
diff --git a/t/op/flip.t b/t/op/flip.t
index 7852d0cee9..20167f3333 100755
--- a/t/op/flip.t
+++ b/t/op/flip.t
@@ -6,7 +6,7 @@ print "1..9\n";
 
 @a = (1,2,3,4,5,6,7,8,9,10,11,12);
 
-while ($_ = shift(a)) {
+while ($_ = shift(@a)) {
     if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; }
     $y .= /1/../2/;
 }
diff --git a/t/op/pat.t b/t/op/pat.t
index 5ea9bb44ae..e6b90158f9 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -67,7 +67,7 @@ $XXX{234} = 234;
 $XXX{345} = 345;
 
 @XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
-while ($_ = shift(XXX)) {
+while ($_ = shift(@XXX)) {
     ?(.*)? && (print $1,"\n");
     /not/ && reset;
     /not ok 26/ && reset 'X';
diff --git a/t/op/push.t b/t/op/push.t
index f62a4e9d8e..a67caed2b3 100755
--- a/t/op/push.t
+++ b/t/op/push.t
@@ -16,7 +16,7 @@
 -4,			4 5 6 7,	0 1 2 3
 EOF
 
-print "1..", 2 + @tests, "\n";
+print "1..", 4 + @tests, "\n";
 die "blech" unless @tests;
 
 @x = (1,2,3);
@@ -25,7 +25,13 @@ if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
 push(@x,4);
 if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
 
-$test = 3;
+# test for push/pop intuiting @ on array
+push(x,3);
+if (join(':',@x) eq '1:2:3:1:2:3:4:3') {print "ok 3\n";} else {print "not ok 3\n";}
+pop(x);
+if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$test = 5;
 foreach $line (@tests) {
     ($list,$get,$leave) = split(/,\t*/,$line);
     ($pos, $len, @list) = split(' ',$list);
diff --git a/t/op/wantarray.t b/t/op/wantarray.t
new file mode 100755
index 0000000000..0a47b6d3ba
--- /dev/null
+++ b/t/op/wantarray.t
@@ -0,0 +1,16 @@
+#!./perl
+
+print "1..3\n";
+sub context {
+  my ( $cona, $testnum ) = @_;
+  my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
+  unless ( $cona eq $conb ) {
+	print "# Context $conb should be $cona\nnot ";
+  }
+  print "ok $testnum\n";
+}
+
+context('V',1);
+$a = context('S',2);
+@a = context('A',3);
+1;