Commit | Line | Data |
---|---|---|
0d863452 RH |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | use strict; | |
289d21b2 RGS |
9 | use warnings; |
10 | no warnings 'uninitialized'; | |
0d863452 RH |
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 RGS |
17 | my @empty; |
18 | my %empty; | |
015eb7b9 | 19 | my @sparse; $sparse[2] = 2; |
031a44ed | 20 | |
0d863452 RH |
21 | my $deep1 = []; push @$deep1, \$deep1; |
22 | my $deep2 = []; push @$deep2, \$deep2; | |
23 | ||
0d863452 RH |
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 YK |
32 | { |
33 | package Test::Object::NoOverload; | |
34 | sub new { bless { key => 1 } } | |
35 | } | |
36 | ||
37 | { | |
6fbc735b RGS |
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 RGS |
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 YK |
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 RGS |
64 | my %refh; |
65 | if (!$ENV{PERL_CORE_MINITEST}) { | |
66 | tie %refh, 'Tie::RefHash'; | |
67 | $refh{$ov_obj} = 1; | |
68 | } | |
b15feb55 | 69 | |
73aec0b1 RGS |
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 |
be99ef1a | 76 | plan tests => 335; |
0d863452 | 77 | |
9e079ace | 78 | while (<DATA>) { |
c5836baf | 79 | SKIP: { |
9e079ace RGS |
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 RGS |
91 | my $res; |
92 | if ($note =~ /NOWARNINGS/) { | |
93 | $res = eval "no warnings; $tstr"; | |
94 | } | |
c5836baf RGS |
95 | elsif ($note =~ /MINISKIP/ && $ENV{PERL_CORE_MINITEST}) { |
96 | skip("Doesn't work with miniperl", $yn =~ /=/ ? 2 : 1); | |
97 | } | |
289d21b2 RGS |
98 | else { |
99 | $res = eval $tstr; | |
100 | } | |
0d863452 | 101 | |
a86f5011 YK |
102 | chomp $@; |
103 | ||
85af77a5 | 104 | if ( $yn =~ /@/ ) { |
9e079ace RGS |
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 RGS |
110 | fail($test_name); |
111 | print "# \$\@ was: $@\n"; | |
a86f5011 | 112 | } else { |
85af77a5 | 113 | ok( ($yn =~ /!/ xor $res), $test_name ); |
a86f5011 YK |
114 | } |
115 | } | |
85af77a5 RGS |
116 | |
117 | if ( $yn =~ s/=// ) { | |
118 | $tstr = "$right ~~ $left"; | |
119 | goto test_again; | |
120 | } | |
c5836baf | 121 | } |
0d863452 RH |
122 | } |
123 | ||
0d863452 | 124 | sub foo {} |
73aec0b1 RGS |
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 RGS |
130 | sub FALSE() { 0 } |
131 | sub TRUE() { 1 } | |
2522c35a | 132 | sub NOT_DEF() { undef } |
0d863452 | 133 | |
e5de85fa RGS |
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 RGS |
141 | # Object-overloaded |
142 | # Object | |
73aec0b1 RGS |
143 | # Coderef |
144 | # Hash | |
145 | # Hashref | |
146 | # Array | |
147 | # Arrayref | |
85af77a5 RGS |
148 | # Tied arrays and hashes |
149 | # Arrays that reference themselves | |
73aec0b1 | 150 | # Regex (// and qr//) |
85af77a5 | 151 | # Range |
73aec0b1 RGS |
152 | # Num |
153 | # Str | |
85af77a5 RGS |
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 RGS |
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 RGS |
180 | NOT_DEF undef |
181 | &NOT_DEF undef | |
85af77a5 RGS |
182 | |
183 | # Any ~~ object overloaded | |
ad0781bc | 184 | ! \&fatal $ov_obj |
2c9d2554 RGS |
185 | 'cigam' $ov_obj |
186 | ! 'cigam on' $ov_obj | |
532217f1 RGS |
187 | ! ['cigam'] $ov_obj |
188 | ! ['stringified'] $ov_obj | |
189 | ! { cigam => 1 } $ov_obj | |
190 | ! { stringified => 1 } $ov_obj | |
ad0781bc RGS |
191 | ! $obj $ov_obj |
192 | ! undef $ov_obj | |
1cfb7049 YK |
193 | |
194 | # regular object | |
ad0781bc | 195 | @ $obj $obj |
6d743019 | 196 | @ $ov_obj $obj |
2c9d2554 | 197 | =@ \&fatal $obj |
ad0781bc RGS |
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 RGS |
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 RGS |
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 RGS |
237 | $ov_obj 'magic' |
238 | ! $ov_obj 'not magic' | |
1cfb7049 | 239 | |
a4a197da RGS |
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 RGS |
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 RGS |
264 | NOT_DEF sub{not shift} |
265 | &NOT_DEF sub{not shift} | |
a4a197da RGS |
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 RGS |
275 | [] \&foo |
276 | {} \&foo | |
031a44ed RGS |
277 | @empty \&foo |
278 | %empty \&foo | |
a4a197da RGS |
279 | ! qr// \&foo |
280 | ! undef \&foo | |
281 | undef \&bar | |
282 | @ undef \&fatal | |
283 | @ 1 \&fatal | |
284 | @ [1] \&fatal | |
203d1e89 | 285 | @ {a=>1} \&fatal |
a4a197da RGS |
286 | @ "foo" \&fatal |
287 | @ qr// \&fatal | |
203d1e89 | 288 | # sub is not called on empty hashes / arrays |
07edf497 RGS |
289 | [] \&fatal |
290 | +{} \&fatal | |
031a44ed RGS |
291 | @empty \&fatal |
292 | %empty \&fatal | |
532217f1 RGS |
293 | # sub is not special on the left |
294 | sub {0} qr/^CODE/ | |
295 | sub {0} sub { ref shift eq "CODE" } | |
0d863452 | 296 | |
0d863452 RH |
297 | # HASH ref against: |
298 | # - another hash ref | |
299 | {} {} | |
2a37c5e7 | 300 | =! {} {1 => 2} |
0d863452 RH |
301 | {1 => 2} {1 => 2} |
302 | {1 => 2} {1 => 3} | |
031a44ed RGS |
303 | =! {1 => 2} {2 => 3} |
304 | = \%main:: {map {$_ => 'x'} keys %main::} | |
0d863452 RH |
305 | |
306 | # - tied hash ref | |
2522c35a | 307 | = \%hash \%tied_hash |
0d863452 | 308 | \%tied_hash \%tied_hash |
031a44ed RGS |
309 | != {"a"=>"b"} \%tied_hash |
310 | = %hash %tied_hash | |
311 | %tied_hash %tied_hash | |
312 | != {"a"=>"b"} %tied_hash | |
c5836baf RGS |
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 RH |
318 | |
319 | # - an array ref | |
031a44ed RGS |
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 RH |
339 | |
340 | # - a regex | |
ea0c2dbd RGS |
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 RGS |
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 RGS |
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 RGS |
367 | ! undef %hash |
368 | ! undef +{"" => "empty key"} | |
2a37c5e7 | 369 | ! undef {} |
0d863452 RH |
370 | |
371 | # ARRAY ref against: | |
372 | # - another array ref | |
1cfb7049 | 373 | [] [] |
2522c35a | 374 | =! [] [1] |
ea0c2dbd RGS |
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 RGS |
388 | = \@nums \@tied_nums |
389 | = @nums \@tied_nums | |
390 | = \@nums @tied_nums | |
391 | = @nums @tied_nums | |
392 | ||
d0b243e3 RGS |
393 | # - an object |
394 | ! $obj @fooormore | |
41e726ac | 395 | $obj [sub{ref shift}] |
d0b243e3 | 396 | |
0d863452 | 397 | # - a regex |
ea0c2dbd RGS |
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 RH |
404 | |
405 | # - a number | |
015eb7b9 | 406 | 2 [qw(1.00 2.00)] |
b0138e99 RGS |
407 | 2 [qw(foo 2)] |
408 | 2.0_0e+0 [qw(foo 2)] | |
409 | ! 2 [qw(1foo bar2)] | |
0d863452 RH |
410 | |
411 | # - a string | |
b0138e99 RGS |
412 | ! "2" [qw(1foo 2bar)] |
413 | "2bar" [qw(1foo 2bar)] | |
0d863452 | 414 | |
015eb7b9 RGS |
415 | # - undef |
416 | undef [1, 2, undef, 4] | |
417 | ! undef [1, 2, [undef], 4] | |
418 | ! undef @fooormore | |
419 | undef @sparse | |
fb51372e RGS |
420 | undef [undef] |
421 | ! 0 [undef] | |
422 | ! "" [undef] | |
423 | ! undef [0] | |
424 | ! undef [""] | |
015eb7b9 RGS |
425 | |
426 | # - nested arrays and ~~ distributivity | |
427 | 11 [[11]] | |
428 | ! 11 [[12]] | |
429 | "foo" [{foo => "bar"}] | |
430 | ! "bar" [{foo => "bar"}] | |
431 | ||
0d863452 RH |
432 | # Number against number |
433 | 2 2 | |
33ed63a2 | 434 | 20 2_0 |
0d863452 | 435 | ! 2 3 |
18d11902 RGS |
436 | 0 FALSE |
437 | 3-2 TRUE | |
fb51372e RGS |
438 | ! undef 0 |
439 | ! (my $u) 0 | |
0d863452 RH |
440 | |
441 | # Number against string | |
33ed63a2 RGS |
442 | = 2 "2" |
443 | = 2 "2.0" | |
0d863452 | 444 | ! 2 "2bananas" |
289d21b2 | 445 | != 2_3 "2_3" NOWARNINGS |
18d11902 | 446 | FALSE "0" |
fb51372e RGS |
447 | ! undef "0" |
448 | ! undef "" | |
0d863452 RH |
449 | |
450 | # Regex against string | |
a566f585 RGS |
451 | "x" qr/x/ |
452 | ! "x" qr/y/ | |
0d863452 RH |
453 | |
454 | # Regex against number | |
455 | 12345 qr/3/ | |
2522c35a | 456 | ! 12345 qr/7/ |
0d863452 | 457 | |
031a44ed | 458 | # array/hash against string |
d444f7e3 RGS |
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 RH |
466 | @nums \@nums |
467 | ! @nums \\@nums | |
468 | @nums [1..10] | |
469 | ! @nums [0..9] | |
470 | ||
2e0e16c9 RGS |
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 DK |
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, '' } | |
be99ef1a YK |
486 | |
487 | # UNDEF | |
488 | ! 3 undef | |
489 | ! 1 undef | |
490 | ! [] undef | |
491 | ! {} undef | |
492 | ! \%::main undef | |
493 | ! [1,2] undef | |
494 | ! %hash undef | |
495 | ! @nums undef | |
496 | ! "foo" undef | |
497 | ! "" undef | |
498 | ! !1 undef | |
499 | ! \&foo undef | |
500 | ! sub { } undef |