Commit | Line | Data |
---|---|---|
378cc40b LW |
1 | #!./perl |
2 | ||
7583b5e8 DL |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
5 | @INC = qw(. ../lib); | |
6 | } | |
7 | ||
8 | require "test.pl"; | |
9 | plan( tests => 38 ); | |
01020589 GS |
10 | |
11 | # delete() on hash elements | |
378cc40b LW |
12 | |
13 | $foo{1} = 'a'; | |
14 | $foo{2} = 'b'; | |
15 | $foo{3} = 'c'; | |
5f05dabc | 16 | $foo{4} = 'd'; |
17 | $foo{5} = 'e'; | |
378cc40b LW |
18 | |
19 | $foo = delete $foo{2}; | |
20 | ||
7583b5e8 DL |
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 DL |
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 LW |
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 LW |
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 GS |
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 GS |
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 DL |
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 GS |
85 | |
86 | @bar = delete @foo[4,5]; | |
87 | ||
7583b5e8 DL |
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 GS |
95 | |
96 | $foo = join('',@foo); | |
7583b5e8 DL |
97 | cmp_ok($foo,'eq','ac','ary elems'); |
98 | cmp_ok(scalar(@foo),'==',4,'four is the number thou shalt count'); | |
01020589 GS |
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 GS |
105 | |
106 | $foo[0] = 'x'; | |
107 | $foo[1] = 'y'; | |
108 | ||
109 | $foo = "@foo"; | |
7583b5e8 | 110 | cmp_ok($foo,'eq','x y','two fresh'); |
01020589 GS |
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 GS |
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 DM |
127 | |
128 | { | |
9111c9c0 DM |
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 DM |
133 | |
134 | { | |
2c8ddff3 DM |
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 | } |