Commit | Line | Data |
---|---|---|
378cc40b LW |
1 | #!./perl |
2 | ||
01020589 GS |
3 | print "1..36\n"; |
4 | ||
5 | # delete() on hash elements | |
378cc40b LW |
6 | |
7 | $foo{1} = 'a'; | |
8 | $foo{2} = 'b'; | |
9 | $foo{3} = 'c'; | |
5f05dabc | 10 | $foo{4} = 'd'; |
11 | $foo{5} = 'e'; | |
378cc40b LW |
12 | |
13 | $foo = delete $foo{2}; | |
14 | ||
a687059c | 15 | if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";} |
01020589 | 16 | unless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";} |
378cc40b LW |
17 | if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";} |
18 | if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";} | |
5f05dabc | 19 | if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";} |
20 | if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";} | |
21 | ||
22 | @foo = delete @foo{4, 5}; | |
23 | ||
24 | if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";} | |
25 | if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";} | |
26 | if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";} | |
01020589 GS |
27 | unless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";} |
28 | unless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";} | |
5f05dabc | 29 | if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";} |
30 | if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";} | |
378cc40b | 31 | |
c6aa4a32 | 32 | $foo = join('',values(%foo)); |
5f05dabc | 33 | if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";} |
378cc40b | 34 | |
c6aa4a32 | 35 | foreach $key (keys %foo) { |
378cc40b LW |
36 | delete $foo{$key}; |
37 | } | |
38 | ||
39 | $foo{'foo'} = 'x'; | |
40 | $foo{'bar'} = 'y'; | |
41 | ||
c6aa4a32 | 42 | $foo = join('',values(%foo)); |
5f05dabc | 43 | print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n"; |
a0d0e21e LW |
44 | |
45 | $refhash{"top"}->{"foo"} = "FOO"; | |
46 | $refhash{"top"}->{"bar"} = "BAR"; | |
47 | ||
48 | delete $refhash{"top"}->{"bar"}; | |
49 | @list = keys %{$refhash{"top"}}; | |
50 | ||
5f05dabc | 51 | print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n"; |
2f83d9b6 GS |
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 GS |
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 | ||
74 | if ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";} | |
75 | unless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";} | |
76 | if ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";} | |
77 | if ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";} | |
78 | if ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";} | |
79 | if ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";} | |
80 | ||
81 | @bar = delete @foo[4,5]; | |
82 | ||
83 | if (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";} | |
84 | if ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";} | |
85 | if ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";} | |
86 | unless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";} | |
87 | unless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";} | |
88 | if ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";} | |
89 | if ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";} | |
90 | ||
91 | $foo = join('',@foo); | |
92 | if ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";} | |
93 | ||
94 | if (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";} | |
95 | ||
96 | foreach $key (0 .. $#foo) { | |
97 | delete $foo[$key]; | |
98 | } | |
99 | ||
100 | if (@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"; | |
106 | print +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n"; | |
107 | ||
108 | $refary[0]->[0] = "FOO"; | |
109 | $refary[0]->[3] = "BAR"; | |
110 | ||
111 | delete $refary[0]->[3]; | |
112 | ||
113 | print @{$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 | } |