Jakub Wilk is now a Perl author.
[perl.git] / t / op / delete.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require "./test.pl";
6     set_up_inc( qw(. ../lib) );
7 }
8
9 plan( tests => 56 );
10
11 # delete() on hash elements
12
13 $foo{1} = 'a';
14 $foo{2} = 'b';
15 $foo{3} = 'c';
16 $foo{4} = 'd';
17 $foo{5} = 'e';
18 $foo{6} = 'f';
19 $foo{7} = 'g';
20
21 $foo = delete $foo{2};
22
23 cmp_ok($foo,'eq','b','delete 2');
24 ok(!(exists $foo{2}),'b absent');
25 cmp_ok($foo{1},'eq','a','a exists');
26 cmp_ok($foo{3},'eq','c','c exists');
27 cmp_ok($foo{4},'eq','d','d exists');
28 cmp_ok($foo{5},'eq','e','e exists');
29
30 @foo = delete @foo{4, 5};
31
32 cmp_ok(scalar(@foo),'==',2,'deleted slice');
33 cmp_ok($foo[0],'eq','d','slice 1');
34 cmp_ok($foo[1],'eq','e','slice 2');
35 ok(!(exists $foo{4}),'d absent');
36 ok(!(exists $foo{5}),'e absent');
37 cmp_ok($foo{1},'eq','a','a still exists');
38 cmp_ok($foo{3},'eq','c','c still exists');
39
40 @foo = delete %foo{6,7};
41
42 cmp_ok(scalar(@foo),'==',4,'deleted kvslice');
43 cmp_ok($foo[0],'eq','6','slice k1');
44 cmp_ok($foo[1],'eq','f','slice v1');
45 cmp_ok($foo[2],'eq','7','slice k2');
46 cmp_ok($foo[3],'eq','g','slice v2');
47 ok(!(exists $foo{5}),'f absent');
48 ok(!(exists $foo{6}),'g absent');
49 cmp_ok($foo{1},'eq','a','a still exists');
50 cmp_ok($foo{3},'eq','c','c still exists');
51
52 $foo = join('',values(%foo));
53 ok($foo eq 'ac' || $foo eq 'ca','remaining keys');
54
55 foreach $key (keys %foo) {
56     delete $foo{$key};
57 }
58
59 $foo{'foo'} = 'x';
60 $foo{'bar'} = 'y';
61
62 $foo = join('',values(%foo));
63 ok($foo eq 'xy' || $foo eq 'yx','fresh keys');
64
65 $refhash{"top"}->{"foo"} = "FOO";
66 $refhash{"top"}->{"bar"} = "BAR";
67
68 delete $refhash{"top"}->{"bar"};
69 @list = keys %{$refhash{"top"}};
70
71 cmp_ok("@list",'eq',"foo", 'autoviv and delete hashref');
72
73 {
74     my %a = ('bar', 33);
75     my($a) = \(values %a);
76     my $b = \$a{bar};
77     my $c = \delete $a{bar};
78
79     ok($a == $b && $b == $c,'a b c equivalent');
80 }
81
82 # delete() on array elements
83
84 @foo = ();
85 $foo[1] = 'a';
86 $foo[2] = 'b';
87 $foo[3] = 'c';
88 $foo[4] = 'd';
89 $foo[5] = 'e';
90 $foo[6] = 'f';
91 $foo[7] = 'g';
92
93 $foo = delete $foo[2];
94
95 cmp_ok($foo,'eq','b','ary delete 2');
96 ok(!(exists $foo[2]),'ary b absent');
97 cmp_ok($foo[1],'eq','a','ary a exists');
98 cmp_ok($foo[3],'eq','c','ary c exists');
99 cmp_ok($foo[4],'eq','d','ary d exists');
100 cmp_ok($foo[5],'eq','e','ary e exists');
101
102 @bar = delete @foo[4,5];
103
104 cmp_ok(scalar(@bar),'==',2,'ary deleted slice');
105 cmp_ok($bar[0],'eq','d','ary slice 1');
106 cmp_ok($bar[1],'eq','e','ary slice 2');
107 ok(!(exists $foo[4]),'ary d absent');
108 ok(!(exists $foo[5]),'ary e absent');
109 cmp_ok($foo[1],'eq','a','ary a still exists');
110 cmp_ok($foo[3],'eq','c','ary c still exists');
111
112 @bar = delete %foo[6,7];
113
114 cmp_ok(scalar(@bar),'==',4,'deleted kvslice');
115 cmp_ok($bar[0],'eq','6','slice k1');
116 cmp_ok($bar[1],'eq','f','slice v1');
117 cmp_ok($bar[2],'eq','7','slice k2');
118 cmp_ok($bar[3],'eq','g','slice v2');
119 ok(!(exists $bar[5]),'f absent');
120 ok(!(exists $bar[6]),'g absent');
121 cmp_ok($foo[1],'eq','a','a still exists');
122 cmp_ok($foo[3],'eq','c','c still exists');
123
124 $foo = join('',@foo);
125 cmp_ok($foo,'eq','ac','ary elems');
126 cmp_ok(scalar(@foo),'==',4,'four is the number thou shalt count');
127
128 foreach $key (0 .. $#foo) {
129     delete $foo[$key];
130 }
131
132 cmp_ok(scalar(@foo),'==',0,'and then there were none');
133
134 $foo[0] = 'x';
135 $foo[1] = 'y';
136
137 $foo = "@foo";
138 cmp_ok($foo,'eq','x y','two fresh');
139
140 $refary[0]->[0] = "FOO";
141 $refary[0]->[3] = "BAR";
142
143 delete $refary[0]->[3];
144
145 cmp_ok( scalar(@{$refary[0]}),'==',1,'one down');
146
147 {
148     my @a = 33;
149     my($a) = \(@a);
150     my $b = \$a[0];
151     my $c = \delete $a[bar];
152
153     ok($a == $b && $b == $c,'a b c also equivalent');
154 }
155
156 {
157     my %h;
158     my ($x,$y) = (1, scalar delete @h{()});
159     ok(!defined($y),q([perl #29127] scalar delete of empty slice returned garbage));
160 }
161
162 {
163     my $x = 0;
164     sub X::DESTROY { $x++ }
165     {
166         my @a;
167         $a[0] = bless [], 'X';
168         my $y = delete $a[0];
169     }
170     cmp_ok($x,'==',1,q([perl #30733] array delete didn't free returned element));
171 }