Commit | Line | Data |
0d863452 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
7 | } |
8 | use strict; |
9 | |
10 | use Tie::Array; |
11 | use Tie::Hash; |
12 | |
0d863452 |
13 | # Predeclare vars used in the tests: |
031a44ed |
14 | my @empty; |
15 | my %empty; |
16 | |
0d863452 |
17 | my $deep1 = []; push @$deep1, \$deep1; |
18 | my $deep2 = []; push @$deep2, \$deep2; |
19 | |
0d863452 |
20 | my @nums = (1..10); |
21 | tie my @tied_nums, 'Tie::StdArray'; |
22 | @tied_nums = (1..10); |
23 | |
24 | my %hash = (foo => 17, bar => 23); |
25 | tie my %tied_hash, 'Tie::StdHash'; |
26 | %tied_hash = %hash; |
27 | |
1cfb7049 |
28 | { |
29 | package Test::Object::NoOverload; |
30 | sub new { bless { key => 1 } } |
31 | } |
32 | |
33 | { |
34 | package Test::Object::CopyOverload; |
2522c35a |
35 | sub new { bless { key => 'magic' } } |
36 | use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] eq $hash{key} }; |
1cfb7049 |
37 | } |
38 | |
1cfb7049 |
39 | our $ov_obj = Test::Object::CopyOverload->new; |
40 | our $obj = Test::Object::NoOverload->new; |
1cfb7049 |
41 | |
73aec0b1 |
42 | my @keyandmore = qw(key and more); |
43 | my @fooormore = qw(foo or more); |
44 | my %keyandmore = map { $_ => 0 } @keyandmore; |
45 | my %fooormore = map { $_ => 0 } @fooormore; |
46 | |
0d863452 |
47 | # Load and run the tests |
9e079ace |
48 | plan "no_plan"; |
0d863452 |
49 | |
9e079ace |
50 | while (<DATA>) { |
51 | next if /^#/ || !/\S/; |
52 | chomp; |
73aec0b1 |
53 | my ($yn, $left, $right, $note) = split /\t+/; |
0d863452 |
54 | |
73aec0b1 |
55 | local $::TODO = $note =~ /TODO/; |
0d863452 |
56 | |
85af77a5 |
57 | die "Bad test spec: ($yn, $left, $right)" if $yn =~ /[^!@=]/; |
9e079ace |
58 | |
0d863452 |
59 | my $tstr = "$left ~~ $right"; |
9e079ace |
60 | |
85af77a5 |
61 | test_again: |
9e079ace |
62 | my $res = eval $tstr; |
0d863452 |
63 | |
a86f5011 |
64 | chomp $@; |
65 | |
85af77a5 |
66 | if ( $yn =~ /@/ ) { |
9e079ace |
67 | ok( $@ ne '', "$tstr dies" ) |
68 | and print "# \$\@ was: $@\n"; |
a86f5011 |
69 | } else { |
85af77a5 |
70 | my $test_name = $tstr . ($yn =~ /!/ ? " does not match" : " matches"); |
a86f5011 |
71 | if ( $@ ne '' ) { |
9e079ace |
72 | fail($test_name); |
73 | print "# \$\@ was: $@\n"; |
a86f5011 |
74 | } else { |
85af77a5 |
75 | ok( ($yn =~ /!/ xor $res), $test_name ); |
a86f5011 |
76 | } |
77 | } |
85af77a5 |
78 | |
79 | if ( $yn =~ s/=// ) { |
80 | $tstr = "$right ~~ $left"; |
81 | goto test_again; |
82 | } |
0d863452 |
83 | } |
84 | |
0d863452 |
85 | sub foo {} |
73aec0b1 |
86 | sub bar {42} |
87 | sub gorch {42} |
1cfb7049 |
88 | sub fatal {die "fatal sub\n"} |
0d863452 |
89 | |
0cfbf1ea |
90 | # to test constant folding |
18d11902 |
91 | sub FALSE() { 0 } |
92 | sub TRUE() { 1 } |
2522c35a |
93 | sub NOT_DEF() { undef } |
0d863452 |
94 | |
e5de85fa |
95 | # Prefix character : |
96 | # - expected to match |
97 | # ! - expected to not match |
98 | # @ - expected to be a compilation failure |
85af77a5 |
99 | # = - expected to match symmetrically (runs test twice) |
73aec0b1 |
100 | # Data types to test : |
85af77a5 |
101 | # undef |
73aec0b1 |
102 | # Object-overloaded |
103 | # Object |
73aec0b1 |
104 | # Coderef |
105 | # Hash |
106 | # Hashref |
107 | # Array |
108 | # Arrayref |
85af77a5 |
109 | # Tied arrays and hashes |
110 | # Arrays that reference themselves |
73aec0b1 |
111 | # Regex (// and qr//) |
85af77a5 |
112 | # Range |
73aec0b1 |
113 | # Num |
114 | # Str |
85af77a5 |
115 | # Other syntactic items of interest: |
116 | # Constants |
117 | # Values returned by a sub call |
0d863452 |
118 | __DATA__ |
85af77a5 |
119 | # Any ~~ undef |
ad0781bc |
120 | ! $ov_obj undef |
85af77a5 |
121 | ! $obj undef |
122 | ! sub {} undef |
123 | ! %hash undef |
124 | ! \%hash undef |
125 | ! {} undef |
126 | ! @nums undef |
127 | ! \@nums undef |
128 | ! [] undef |
129 | ! %tied_hash undef |
130 | ! @tied_nums undef |
131 | ! $deep1 undef |
132 | ! /foo/ undef |
133 | ! qr/foo/ undef |
134 | ! 21..30 undef |
135 | ! 189 undef |
136 | ! "foo" undef |
137 | ! "" undef |
138 | ! !1 undef |
139 | undef undef |
62ec5f58 |
140 | (my $u) undef |
2522c35a |
141 | NOT_DEF undef |
142 | &NOT_DEF undef |
85af77a5 |
143 | |
144 | # Any ~~ object overloaded |
ad0781bc |
145 | ! \&fatal $ov_obj |
146 | 'magic' $ov_obj |
147 | ! 'not magic' $ov_obj |
148 | ! $obj $ov_obj |
149 | ! undef $ov_obj |
1cfb7049 |
150 | |
151 | # regular object |
ad0781bc |
152 | @ $obj $obj |
153 | @ $ov_obj $obj TODO |
154 | @ \&fatal $obj |
155 | @ \&FALSE $obj |
156 | @ \&foo $obj |
157 | @ sub { 1 } $obj |
158 | @ sub { 0 } $obj |
159 | @ %keyandmore $obj |
160 | @ {"key" => 1} $obj |
161 | @ @fooormore $obj |
162 | @ ["key" => 1] $obj |
163 | @ /key/ $obj |
164 | @ qr/key/ $obj |
165 | @ "key" $obj |
166 | @ FALSE $obj |
167 | |
168 | # object (overloaded or not) ~~ Any |
169 | # TODO |
1cfb7049 |
170 | |
a4a197da |
171 | # ~~ Coderef |
172 | sub{0} sub { ref $_[0] eq "CODE" } |
173 | %fooormore sub { $_[0] =~ /^(foo|or|more)$/ } |
174 | ! %fooormore sub { $_[0] =~ /^(foo|or|less)$/ } |
175 | \%fooormore sub { $_[0] =~ /^(foo|or|more)$/ } |
176 | ! \%fooormore sub { $_[0] =~ /^(foo|or|less)$/ } |
177 | +{%fooormore} sub { $_[0] =~ /^(foo|or|more)$/ } |
178 | ! +{%fooormore} sub { $_[0] =~ /^(foo|or|less)$/ } |
179 | @fooormore sub { $_[0] =~ /^(foo|or|more)$/ } |
180 | ! @fooormore sub { $_[0] =~ /^(foo|or|less)$/ } |
181 | \@fooormore sub { $_[0] =~ /^(foo|or|more)$/ } |
182 | ! \@fooormore sub { $_[0] =~ /^(foo|or|less)$/ } |
183 | [@fooormore] sub { $_[0] =~ /^(foo|or|more)$/ } |
184 | ! [@fooormore] sub { $_[0] =~ /^(foo|or|less)$/ } |
185 | %fooormore sub{@_==1} |
186 | @fooormore sub{@_==1} |
187 | "foo" sub { $_[0] =~ /^(foo|or|more)$/ } |
188 | ! "more" sub { $_[0] =~ /^(foo|or|less)$/ } |
73aec0b1 |
189 | /fooormore/ sub{ref $_[0] eq 'Regexp'} |
a4a197da |
190 | qr/fooormore/ sub{ref $_[0] eq 'Regexp'} |
191 | 1 sub{shift} |
192 | ! 0 sub{shift} |
193 | ! undef sub{shift} |
194 | undef sub{not shift} |
031a44ed |
195 | NOT_DEF sub{not shift} |
196 | &NOT_DEF sub{not shift} |
a4a197da |
197 | FALSE sub{not shift} |
198 | [1] \&bar |
199 | {a=>1} \&bar |
200 | qr// \&bar |
201 | ! [1] \&foo |
202 | ! {a=>1} \&foo |
203 | # empty stuff matches, because the sub is never called: |
07edf497 |
204 | [] \&foo |
205 | {} \&foo |
031a44ed |
206 | @empty \&foo |
207 | %empty \&foo |
a4a197da |
208 | ! qr// \&foo |
209 | ! undef \&foo |
210 | undef \&bar |
211 | @ undef \&fatal |
212 | @ 1 \&fatal |
213 | @ [1] \&fatal |
203d1e89 |
214 | @ {a=>1} \&fatal |
a4a197da |
215 | @ "foo" \&fatal |
216 | @ qr// \&fatal |
203d1e89 |
217 | # sub is not called on empty hashes / arrays |
07edf497 |
218 | [] \&fatal |
219 | +{} \&fatal |
031a44ed |
220 | @empty \&fatal |
221 | %empty \&fatal |
0d863452 |
222 | |
0d863452 |
223 | # HASH ref against: |
224 | # - another hash ref |
225 | {} {} |
2a37c5e7 |
226 | =! {} {1 => 2} |
0d863452 |
227 | {1 => 2} {1 => 2} |
228 | {1 => 2} {1 => 3} |
031a44ed |
229 | =! {1 => 2} {2 => 3} |
230 | = \%main:: {map {$_ => 'x'} keys %main::} |
0d863452 |
231 | |
232 | # - tied hash ref |
2522c35a |
233 | = \%hash \%tied_hash |
0d863452 |
234 | \%tied_hash \%tied_hash |
031a44ed |
235 | != {"a"=>"b"} \%tied_hash |
236 | = %hash %tied_hash |
237 | %tied_hash %tied_hash |
238 | != {"a"=>"b"} %tied_hash |
0d863452 |
239 | |
240 | # - an array ref |
031a44ed |
241 | # (since this is symmetrical, tests as well hash~~array) |
242 | = [keys %main::] \%:: |
243 | = [qw[STDIN STDOUT]] \%:: |
244 | =! [] \%:: |
245 | =! [""] {} |
246 | =! [] {} |
247 | =! @empty {} |
248 | = [undef] {"" => 1} |
249 | = [""] {"" => 1} |
250 | = ["foo"] { foo => 1 } |
251 | = ["foo", "bar"] { foo => 1 } |
252 | = ["foo", "bar"] \%hash |
253 | = ["foo"] \%hash |
254 | =! ["quux"] \%hash |
255 | = [qw(foo quux)] \%hash |
256 | = @fooormore { foo => 1, or => 2, more => 3 } |
257 | = @fooormore %fooormore |
258 | = @fooormore \%fooormore |
259 | = \@fooormore %fooormore |
0d863452 |
260 | |
261 | # - a regex |
031a44ed |
262 | # TODO those should be symmetrical |
2e0e16c9 |
263 | qr/^(fo[ox])$/ {foo => 1} |
031a44ed |
264 | /^(fo[ox])$/ %fooormore |
265 | =! qr/[13579]$/ +{0..99} |
2a37c5e7 |
266 | ! qr/a*/ {} |
031a44ed |
267 | = qr/a*/ {b=>2} |
268 | qr/B/i {b=>2} |
269 | /B/i {b=>2} |
270 | ! qr/a+/ {b=>2} |
271 | qr/^à/ {"à"=>2} |
0d863452 |
272 | |
031a44ed |
273 | # - a scalar |
2e0e16c9 |
274 | "foo" +{foo => 1, bar => 2} |
031a44ed |
275 | "foo" %fooormore |
2e0e16c9 |
276 | ! "baz" +{foo => 1, bar => 2} |
031a44ed |
277 | ! "boz" %fooormore |
278 | ! 1 +{foo => 1, bar => 2} |
279 | ! 1 %fooormore |
280 | 1 { 1 => 3 } |
281 | 1.0 { 1 => 3 } |
282 | ! "1.0" { 1 => 3 } |
283 | ! "1.0" { 1.0 => 3 } |
284 | "1.0" { "1.0" => 3 } |
285 | "à" { "à" => "À" } |
0d863452 |
286 | |
61a621c6 |
287 | # - undef |
2522c35a |
288 | ! undef { hop => 'zouu' } |
61a621c6 |
289 | ! undef %hash |
290 | ! undef +{"" => "empty key"} |
2a37c5e7 |
291 | ! undef {} |
0d863452 |
292 | |
293 | # ARRAY ref against: |
294 | # - another array ref |
1cfb7049 |
295 | [] [] |
2522c35a |
296 | =! [] [1] |
a566f585 |
297 | ! [["foo"], ["bar"]] [qr/o/, qr/a/] |
298 | [["foo"], ["bar"]] [qr/ARRAY/, qr/ARRAY/] |
0d863452 |
299 | ["foo", "bar"] [qr/o/, qr/a/] |
031a44ed |
300 | ! [qr/o/, qr/a/] ["foo", "bar"] |
2522c35a |
301 | ["foo", "bar"] [["foo"], ["bar"]] |
71b0fb34 |
302 | ! ["foo", "bar"] [qr/o/, "foo"] |
2522c35a |
303 | ["foo", undef, "bar"] [qr/o/, undef, "bar"] |
304 | ["foo", undef, "bar"] [qr/o/, "", "bar"] |
305 | ! ["foo", "", "bar"] [qr/o/, undef, "bar"] |
1cfb7049 |
306 | $deep1 $deep1 |
031a44ed |
307 | @$deep1 @$deep1 |
1cfb7049 |
308 | ! $deep1 $deep2 |
0d863452 |
309 | |
031a44ed |
310 | = \@nums \@tied_nums |
311 | = @nums \@tied_nums |
312 | = \@nums @tied_nums |
313 | = @nums @tied_nums |
314 | |
315 | # - works with lists instead of arrays |
316 | "foo" qw(foo bar) TODO |
317 | "foo" ('foo','bar') TODO |
0d863452 |
318 | |
319 | # - a regex |
b0138e99 |
320 | qr/x/ [qw(foo bar baz quux)] |
321 | ! qr/y/ [qw(foo bar baz quux)] |
322 | /x/ [qw(foo bar baz quux)] |
323 | ! /y/ [qw(foo bar baz quux)] |
031a44ed |
324 | /FOO/i @fooormore |
325 | ! /bar/ @fooormore |
0d863452 |
326 | |
327 | # - a number |
b0138e99 |
328 | 2 [qw(1foo 2bar)] |
329 | 2 [qw(foo 2)] |
330 | 2.0_0e+0 [qw(foo 2)] |
331 | ! 2 [qw(1foo bar2)] |
0d863452 |
332 | |
333 | # - a string |
b0138e99 |
334 | ! "2" [qw(1foo 2bar)] |
335 | "2bar" [qw(1foo 2bar)] |
0d863452 |
336 | |
337 | # Number against number |
338 | 2 2 |
33ed63a2 |
339 | 20 2_0 |
0d863452 |
340 | ! 2 3 |
18d11902 |
341 | 0 FALSE |
342 | 3-2 TRUE |
33ed63a2 |
343 | undef 0 |
0d863452 |
344 | |
345 | # Number against string |
33ed63a2 |
346 | = 2 "2" |
347 | = 2 "2.0" |
0d863452 |
348 | ! 2 "2bananas" |
33ed63a2 |
349 | != 2_3 "2_3" |
18d11902 |
350 | FALSE "0" |
0d863452 |
351 | |
352 | # Regex against string |
a566f585 |
353 | "x" qr/x/ |
354 | ! "x" qr/y/ |
0d863452 |
355 | |
356 | # Regex against number |
357 | 12345 qr/3/ |
2522c35a |
358 | ! 12345 qr/7/ |
0d863452 |
359 | |
031a44ed |
360 | # TODO ranges |
361 | |
362 | # array/hash against string |
d444f7e3 |
363 | @fooormore "".\@fooormore |
364 | ! @keyandmore "".\@fooormore |
365 | %fooormore "".\%fooormore |
366 | ! %keyandmore "".\%fooormore |
f1bef09e |
367 | |
0d863452 |
368 | # Test the implicit referencing |
b0138e99 |
369 | 7 @nums |
0d863452 |
370 | @nums \@nums |
371 | ! @nums \\@nums |
372 | @nums [1..10] |
373 | ! @nums [0..9] |
374 | |
2e0e16c9 |
375 | "foo" %hash |
376 | /bar/ %hash |
377 | [qw(bar)] %hash |
378 | ! [qw(a b c)] %hash |
71b0fb34 |
379 | %hash %hash |
fceebc47 |
380 | %hash +{%hash} |
73aec0b1 |
381 | %hash \%hash |
71b0fb34 |
382 | %hash %tied_hash |
383 | %tied_hash %tied_hash |
384 | %hash { foo => 5, bar => 10 } |
385 | ! %hash { foo => 5, bar => 10, quux => 15 } |
386 | |
387 | @nums { 1, '', 2, '' } |
388 | @nums { 1, '', 12, '' } |
389 | ! @nums { 11, '', 12, '' } |