t/op/delete.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = qw(. ../lib);
   6 }
   7
   8 require "test.pl";
   9 plan( tests => 38 );
  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
  19 $foo = delete $foo{2};
  20
  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');
  27
  28 @foo = delete @foo{4, 5};
  29
  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');
  37
  38 $foo = join('',values(%foo));
  39 ok($foo eq 'ac' || $foo eq 'ca','remaining keys');
  40
  41 foreach $key (keys %foo) {
  42     delete $foo{$key};
  43 }
  44
  45 $foo{'foo'} = 'x';
  46 $foo{'bar'} = 'y';
  47
  48 $foo = join('',values(%foo));
  49 ok($foo eq 'xy' || $foo eq 'yx','fresh keys');
  50
  51 $refhash{"top"}->{"foo"} = "FOO";
  52 $refhash{"top"}->{"bar"} = "BAR";
  53
  54 delete $refhash{"top"}->{"bar"};
  55 @list = keys %{$refhash{"top"}};
  56
  57 cmp_ok("@list",'eq',"foo", 'autoviv and delete hashref');
  58
  59 {
  60     my %a = ('bar', 33);
  61     my($a) = \(values %a);
  62     my $b = \$a{bar};
  63     my $c = \delete $a{bar};
  64
  65     ok($a == $b && $b == $c,'a b c equivalent');
  66 }
  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
  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');
  85
  86 @bar = delete @foo[4,5];
  87
  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');
  95
  96 $foo = join('',@foo);
  97 cmp_ok($foo,'eq','ac','ary elems');
  98 cmp_ok(scalar(@foo),'==',4,'four is the number thou shalt count');
  99
 100 foreach $key (0 .. $#foo) {
 101     delete $foo[$key];
 102 }
 103
 104 cmp_ok(scalar(@foo),'==',0,'and then there were none');
 105
 106 $foo[0] = 'x';
 107 $foo[1] = 'y';
 108
 109 $foo = "@foo";
 110 cmp_ok($foo,'eq','x y','two fresh');
 111
 112 $refary[0]->[0] = "FOO";
 113 $refary[0]->[3] = "BAR";
 114
 115 delete $refary[0]->[3];
 116
 117 cmp_ok( scalar(@{$refary[0]}),'==',1,'one down');
 118
 119 {
 120     my @a = 33;
 121     my($a) = \(@a);
 122     my $b = \$a[0];
 123     my $c = \delete $a[bar];
 124
 125     ok($a == $b && $b == $c,'a b c also equivalent');
 126 }
 127
 128 {
 129     my %h;
 130     my ($x,$y) = (1, scalar delete @h{()});
 131     ok(!defined($y),q([perl #29127] scalar delete of empty slice returned garbage));
 132 }
 133
 134 {
 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     }
 142     cmp_ok($x,'==',1,q([perl #30733] array delete didn't free returned element));
 143 }