Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / t / op / avhv.t
CommitLineData
5d5aaa5e 1#!./perl
10c8fecd 2
6d822dc4 3# This test was originally for pseudo-hashes. It now exists to ensure
4# they were properly removed in 5.9.
5
a60c0954 6BEGIN {
7 chdir 't' if -d 't';
20822f61 8 @INC = '../lib';
a60c0954 9}
10
11require Tie::Array;
5d5aaa5e 12
a60c0954 13package Tie::BasicArray;
14@ISA = 'Tie::Array';
5d5aaa5e 15sub TIEARRAY { bless [], $_[0] }
a60c0954 16sub STORE { $_[0]->[$_[1]] = $_[2] }
17sub FETCH { $_[0]->[$_[1]] }
18sub FETCHSIZE { scalar(@{$_[0]})}
6d822dc4 19sub STORESIZE { $#{$_[0]} = $_[1]+1 }
5d5aaa5e 20
21package main;
22
6d822dc4 23require './test.pl';
24plan(tests => 40);
25
26# Helper function to check the typical error message.
27sub not_hash {
28 my($err) = shift;
29 like( $err, qr/^Not a HASH reference / ) ||
30 printf STDERR "# at %s line %d.\n", (caller)[1,2];
31}
32
33# Something to place inside if blocks and while loops that won't get
34# compiled out.
35my $foo = 42;
36sub no_op { $foo++ }
37
5d5aaa5e 38
39$sch = {
40 'abc' => 1,
41 'def' => 2,
42 'jkl' => 3,
43};
44
45# basic normal array
46$a = [];
47$a->[0] = $sch;
48
6d822dc4 49eval {
50 $a->{'abc'} = 'ABC';
51};
52not_hash($@);
5d5aaa5e 53
6d822dc4 54eval {
55 $a->{'def'} = 'DEF';
56};
57not_hash($@);
5d5aaa5e 58
6d822dc4 59eval {
60 $a->{'jkl'} = 'JKL';
61};
62not_hash($@);
5d5aaa5e 63
6d822dc4 64eval {
65 @keys = keys %$a;
66};
67not_hash($@);
68
69eval {
70 @values = values %$a;
71};
72not_hash($@);
5d5aaa5e 73
6d822dc4 74eval {
75 while( my($k,$v) = each %$a ) {
76 no_op;
5d5aaa5e 77 }
6d822dc4 78};
79not_hash($@);
5d5aaa5e 80
5d5aaa5e 81
82# quick check with tied array
83tie @fake, 'Tie::StdArray';
84$a = \@fake;
85$a->[0] = $sch;
86
6d822dc4 87eval {
88 $a->{'abc'} = 'ABC';
89};
90not_hash($@);
91
92eval {
93 if ($a->{'abc'} eq 'ABC') { no_op(23) } else { no_op(42) }
94};
95not_hash($@);
5d5aaa5e 96
a60c0954 97# quick check with tied array
98tie @fake, 'Tie::BasicArray';
99$a = \@fake;
100$a->[0] = $sch;
101
6d822dc4 102eval {
103 $a->{'abc'} = 'ABC';
104};
105not_hash($@);
106
107eval {
108 if ($a->{'abc'} eq 'ABC') { no_op(23) } else { no_op(42) }
109};
110not_hash($@);
a60c0954 111
5d5aaa5e 112# quick check with tied array & tied hash
5d5aaa5e 113require Tie::Hash;
114tie %fake, Tie::StdHash;
115%fake = %$sch;
116$a->[0] = \%fake;
117
6d822dc4 118eval {
119 $a->{'abc'} = 'ABC';
120};
121not_hash($@);
122
123eval {
124 if ($a->{'abc'} eq 'ABC') { no_op(23) } else { no_op(42) }
125};
126not_hash($@);
127
800e9ae0 128
129# hash slice
6d822dc4 130eval {
131 my $slice = join('', 'x',@$a{'abc','def'},'x');
132};
133not_hash($@);
134
4b154ab5 135
136# evaluation in scalar context
137my $avhv = [{}];
6d822dc4 138
139eval {
140 () = %$avhv;
141};
142not_hash($@);
4b154ab5 143
144push @$avhv, "a";
6d822dc4 145eval {
146 () = %$avhv;
147};
148not_hash($@);
4b154ab5 149
150$avhv = [];
151eval { $a = %$avhv };
6d822dc4 152not_hash($@);
4b154ab5 153
154$avhv = [{foo=>1, bar=>2}];
6d822dc4 155eval {
156 %$avhv =~ m,^\d+/\d+,;
157};
158not_hash($@);
74e13ce4 159
160# check if defelem magic works
161sub f {
162 print "not " unless $_[0] eq 'a';
163 $_[0] = 'b';
164 print "ok 11\n";
165}
166$a = [{key => 1}, 'a'];
6d822dc4 167eval {
168 f($a->{key});
169};
170not_hash($@);
74e13ce4 171
4bd46447 172# check if exists() is behaving properly
173$avhv = [{foo=>1,bar=>2,pants=>3}];
6d822dc4 174eval {
175 no_op if exists $avhv->{bar};
176};
177not_hash($@);
178
179eval {
180 $avhv->{pants} = undef;
181};
182not_hash($@);
4bd46447 183
6d822dc4 184eval {
185 no_op if exists $avhv->{pants};
186};
187not_hash($@);
188
189eval {
190 no_op if exists $avhv->{bar};
191};
192not_hash($@);
01020589 193
6d822dc4 194eval {
195 $avhv->{bar} = 10;
196};
197not_hash($@);
01020589 198
6d822dc4 199eval {
200 no_op unless exists $avhv->{bar} and $avhv->{bar} == 10;
201};
202not_hash($@);
01020589 203
6d822dc4 204eval {
205 $v = delete $avhv->{bar};
206};
207not_hash($@);
01020589 208
6d822dc4 209eval {
210 no_op if exists $avhv->{bar};
211};
212not_hash($@);
01020589 213
6d822dc4 214eval {
215 $avhv->{foo} = 'xxx';
216};
217not_hash($@);
218eval {
219 $avhv->{bar} = 'yyy';
220};
221not_hash($@);
222eval {
223 $avhv->{pants} = 'zzz';
224};
225not_hash($@);
226eval {
227 @x = delete @{$avhv}{'foo','pants'};
228};
229not_hash($@);
230eval {
231 no_op unless "$avhv->{bar}" eq "yyy";
232};
233not_hash($@);
10c8fecd 234
235# hash assignment
6d822dc4 236eval {
237 %$avhv = ();
238};
239not_hash($@);
10c8fecd 240
6d822dc4 241eval {
242 %hv = %$avhv;
243};
244not_hash($@);
10c8fecd 245
6d822dc4 246eval {
247 %$avhv = (foo => 29, pants => 2, bar => 0);
248};
249not_hash($@);
10c8fecd 250
251my $extra;
252my @extra;
6d822dc4 253eval {
254 ($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
255};
256not_hash($@);
257
258eval {
259 %$avhv = ();
260 (%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
261};
262not_hash($@);
263
264eval {
265 @extra = qw(whatever and stuff);
266 %$avhv = ();
267};
268not_hash($@);
269eval {
270 (%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
271};
272not_hash($@);
273
274eval {
275 (@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
276};
277not_hash($@);
e43e3698 278
279# Check hash slices (BUG ID 20010423.002)
280$avhv = [{foo=>1, bar=>2}];
6d822dc4 281eval {
282 @$avhv{"foo", "bar"} = (42, 53);
283};
284not_hash($@);