Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / delete.t
CommitLineData
378cc40b 1#!./perl
2
7583b5e8 3BEGIN {
4 chdir 't' if -d 't';
5 @INC = qw(. ../lib);
6}
7
8require "test.pl";
9plan( 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 21cmp_ok($foo,'eq','b','delete 2');
22ok(!(exists $foo{2}),'b absent');
23cmp_ok($foo{1},'eq','a','a exists');
24cmp_ok($foo{3},'eq','c','c exists');
25cmp_ok($foo{4},'eq','d','d exists');
26cmp_ok($foo{5},'eq','e','e exists');
5f05dabc 27
28@foo = delete @foo{4, 5};
29
7583b5e8 30cmp_ok(scalar(@foo),'==',2,'deleted slice');
31cmp_ok($foo[0],'eq','d','slice 1');
32cmp_ok($foo[1],'eq','e','slice 2');
33ok(!(exists $foo{4}),'d absent');
34ok(!(exists $foo{5}),'e absent');
35cmp_ok($foo{1},'eq','a','a still exists');
36cmp_ok($foo{3},'eq','c','c still exists');
378cc40b 37
c6aa4a32 38$foo = join('',values(%foo));
7583b5e8 39ok($foo eq 'ac' || $foo eq 'ca','remaining keys');
378cc40b 40
c6aa4a32 41foreach $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 49ok($foo eq 'xy' || $foo eq 'yx','fresh keys');
a0d0e21e 50
51$refhash{"top"}->{"foo"} = "FOO";
52$refhash{"top"}->{"bar"} = "BAR";
53
54delete $refhash{"top"}->{"bar"};
55@list = keys %{$refhash{"top"}};
56
7583b5e8 57cmp_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 79cmp_ok($foo,'eq','b','ary delete 2');
80ok(!(exists $foo[2]),'ary b absent');
81cmp_ok($foo[1],'eq','a','ary a exists');
82cmp_ok($foo[3],'eq','c','ary c exists');
83cmp_ok($foo[4],'eq','d','ary d exists');
84cmp_ok($foo[5],'eq','e','ary e exists');
01020589 85
86@bar = delete @foo[4,5];
87
7583b5e8 88cmp_ok(scalar(@bar),'==',2,'ary deleted slice');
89cmp_ok($bar[0],'eq','d','ary slice 1');
90cmp_ok($bar[1],'eq','e','ary slice 2');
91ok(!(exists $foo[4]),'ary d absent');
92ok(!(exists $foo[5]),'ary e absent');
93cmp_ok($foo[1],'eq','a','ary a still exists');
94cmp_ok($foo[3],'eq','c','ary c still exists');
01020589 95
96$foo = join('',@foo);
7583b5e8 97cmp_ok($foo,'eq','ac','ary elems');
98cmp_ok(scalar(@foo),'==',4,'four is the number thou shalt count');
01020589 99
100foreach $key (0 .. $#foo) {
101 delete $foo[$key];
102}
103
7583b5e8 104cmp_ok(scalar(@foo),'==',0,'and then there were none');
01020589 105
106$foo[0] = 'x';
107$foo[1] = 'y';
108
109$foo = "@foo";
7583b5e8 110cmp_ok($foo,'eq','x y','two fresh');
01020589 111
112$refary[0]->[0] = "FOO";
113$refary[0]->[3] = "BAR";
114
115delete $refary[0]->[3];
116
7583b5e8 117cmp_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}