Add more known sprintf failures.
[p5sagit/p5-mst-13.2.git] / t / op / delete.t
CommitLineData
378cc40b 1#!./perl
2
01020589 3print "1..36\n";
4
5# delete() on hash elements
378cc40b 6
7$foo{1} = 'a';
8$foo{2} = 'b';
9$foo{3} = 'c';
5f05dabc 10$foo{4} = 'd';
11$foo{5} = 'e';
378cc40b 12
13$foo = delete $foo{2};
14
a687059c 15if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
01020589 16unless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
378cc40b 17if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
18if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
5f05dabc 19if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";}
20if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";}
21
22@foo = delete @foo{4, 5};
23
24if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";}
25if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";}
26if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";}
01020589 27unless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";}
28unless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
5f05dabc 29if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
30if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
378cc40b 31
c6aa4a32 32$foo = join('',values(%foo));
5f05dabc 33if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";}
378cc40b 34
c6aa4a32 35foreach $key (keys %foo) {
378cc40b 36 delete $foo{$key};
37}
38
39$foo{'foo'} = 'x';
40$foo{'bar'} = 'y';
41
c6aa4a32 42$foo = join('',values(%foo));
5f05dabc 43print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n";
a0d0e21e 44
45$refhash{"top"}->{"foo"} = "FOO";
46$refhash{"top"}->{"bar"} = "BAR";
47
48delete $refhash{"top"}->{"bar"};
49@list = keys %{$refhash{"top"}};
50
5f05dabc 51print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n";
2f83d9b6 52
53{
54 my %a = ('bar', 33);
55 my($a) = \(values %a);
56 my $b = \$a{bar};
57 my $c = \delete $a{bar};
58
59 print "not " unless $a == $b && $b == $c;
60 print "ok 17\n";
61}
01020589 62
63# delete() on array elements
64
65@foo = ();
66$foo[1] = 'a';
67$foo[2] = 'b';
68$foo[3] = 'c';
69$foo[4] = 'd';
70$foo[5] = 'e';
71
72$foo = delete $foo[2];
73
74if ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";}
75unless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";}
76if ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";}
77if ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";}
78if ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";}
79if ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";}
80
81@bar = delete @foo[4,5];
82
83if (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";}
84if ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";}
85if ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";}
86unless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";}
87unless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";}
88if ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";}
89if ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";}
90
91$foo = join('',@foo);
92if ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";}
93
94if (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";}
95
96foreach $key (0 .. $#foo) {
97 delete $foo[$key];
98}
99
100if (@foo == 0) {print "ok 33\n";} else {print "not ok 33\n";}
101
102$foo[0] = 'x';
103$foo[1] = 'y';
104
105$foo = "@foo";
106print +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n";
107
108$refary[0]->[0] = "FOO";
109$refary[0]->[3] = "BAR";
110
111delete $refary[0]->[3];
112
113print @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n";
114
115{
116 my @a = 33;
117 my($a) = \(@a);
118 my $b = \$a[0];
119 my $c = \delete $a[bar];
120
121 print "not " unless $a == $b && $b == $c;
122 print "ok 36\n";
123}