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