1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require "./test.pl"; 6 set_up_inc( qw(. ../lib) ); 7} 8 9plan( 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 23cmp_ok($foo,'eq','b','delete 2'); 24ok(!(exists $foo{2}),'b absent'); 25cmp_ok($foo{1},'eq','a','a exists'); 26cmp_ok($foo{3},'eq','c','c exists'); 27cmp_ok($foo{4},'eq','d','d exists'); 28cmp_ok($foo{5},'eq','e','e exists'); 29 30@foo = delete @foo{4, 5}; 31 32cmp_ok(scalar(@foo),'==',2,'deleted slice'); 33cmp_ok($foo[0],'eq','d','slice 1'); 34cmp_ok($foo[1],'eq','e','slice 2'); 35ok(!(exists $foo{4}),'d absent'); 36ok(!(exists $foo{5}),'e absent'); 37cmp_ok($foo{1},'eq','a','a still exists'); 38cmp_ok($foo{3},'eq','c','c still exists'); 39 40@foo = delete %foo{6,7}; 41 42cmp_ok(scalar(@foo),'==',4,'deleted kvslice'); 43cmp_ok($foo[0],'eq','6','slice k1'); 44cmp_ok($foo[1],'eq','f','slice v1'); 45cmp_ok($foo[2],'eq','7','slice k2'); 46cmp_ok($foo[3],'eq','g','slice v2'); 47ok(!(exists $foo{5}),'f absent'); 48ok(!(exists $foo{6}),'g absent'); 49cmp_ok($foo{1},'eq','a','a still exists'); 50cmp_ok($foo{3},'eq','c','c still exists'); 51 52$foo = join('',values(%foo)); 53ok($foo eq 'ac' || $foo eq 'ca','remaining keys'); 54 55foreach $key (keys %foo) { 56 delete $foo{$key}; 57} 58 59$foo{'foo'} = 'x'; 60$foo{'bar'} = 'y'; 61 62$foo = join('',values(%foo)); 63ok($foo eq 'xy' || $foo eq 'yx','fresh keys'); 64 65$refhash{"top"}->{"foo"} = "FOO"; 66$refhash{"top"}->{"bar"} = "BAR"; 67 68delete $refhash{"top"}->{"bar"}; 69@list = keys %{$refhash{"top"}}; 70 71cmp_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 95cmp_ok($foo,'eq','b','ary delete 2'); 96ok(!(exists $foo[2]),'ary b absent'); 97cmp_ok($foo[1],'eq','a','ary a exists'); 98cmp_ok($foo[3],'eq','c','ary c exists'); 99cmp_ok($foo[4],'eq','d','ary d exists'); 100cmp_ok($foo[5],'eq','e','ary e exists'); 101 102@bar = delete @foo[4,5]; 103 104cmp_ok(scalar(@bar),'==',2,'ary deleted slice'); 105cmp_ok($bar[0],'eq','d','ary slice 1'); 106cmp_ok($bar[1],'eq','e','ary slice 2'); 107ok(!(exists $foo[4]),'ary d absent'); 108ok(!(exists $foo[5]),'ary e absent'); 109cmp_ok($foo[1],'eq','a','ary a still exists'); 110cmp_ok($foo[3],'eq','c','ary c still exists'); 111 112@bar = delete %foo[6,7]; 113 114cmp_ok(scalar(@bar),'==',4,'deleted kvslice'); 115cmp_ok($bar[0],'eq','6','slice k1'); 116cmp_ok($bar[1],'eq','f','slice v1'); 117cmp_ok($bar[2],'eq','7','slice k2'); 118cmp_ok($bar[3],'eq','g','slice v2'); 119ok(!(exists $bar[5]),'f absent'); 120ok(!(exists $bar[6]),'g absent'); 121cmp_ok($foo[1],'eq','a','a still exists'); 122cmp_ok($foo[3],'eq','c','c still exists'); 123 124$foo = join('',@foo); 125cmp_ok($foo,'eq','ac','ary elems'); 126cmp_ok(scalar(@foo),'==',4,'four is the number thou shalt count'); 127 128foreach $key (0 .. $#foo) { 129 delete $foo[$key]; 130} 131 132cmp_ok(scalar(@foo),'==',0,'and then there were none'); 133 134$foo[0] = 'x'; 135$foo[1] = 'y'; 136 137$foo = "@foo"; 138cmp_ok($foo,'eq','x y','two fresh'); 139 140$refary[0]->[0] = "FOO"; 141$refary[0]->[3] = "BAR"; 142 143delete $refary[0]->[3]; 144 145cmp_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} 172