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 }