5.004_58, move intuition tests
Stephen Potter [Thu, 12 Feb 1998 17:11:05 +0000 (11:11 -0600)]
p4raw-id: //depot/perl@536

t/lib/anydbm.t
t/lib/gdbm.t
t/lib/ndbm.t
t/lib/odbm.t
t/lib/sdbm.t
t/op/array.t
t/op/delete.t
t/op/each.t
t/op/flip.t
t/op/pat.t
t/op/push.t

index 854f146..ce3003e 100755 (executable)
@@ -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'} = '';
index fea0cd7..2395611 100755 (executable)
@@ -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'} = '';
index db9846a..a97dbd1 100755 (executable)
@@ -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'} = '';
index 65c9870..8ba9bcf 100755 (executable)
@@ -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'} = '';
index 90dbb84..c2952ec 100755 (executable)
@@ -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'} = '';
index db70c39..f307655 100755 (executable)
@@ -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";
index 4e00566..6cc4475 100755 (executable)
@@ -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";
index b92dd17..420fdc0 100755 (executable)
@@ -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" }
index 7852d0c..20167f3 100755 (executable)
@@ -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/;
 }
index 5ea9bb4..e6b9015 100755 (executable)
@@ -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';
index f62a4e9..a67caed 100755 (executable)
@@ -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);