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