Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / 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 }