This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get t/uni/cache.t working under minitest
[perl5.git] / t / op / smartmatch.t
CommitLineData
0d863452
RH
1#!./perl
2
3BEGIN {
4 chdir 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8use strict;
289d21b2
RGS
9use warnings;
10no warnings 'uninitialized';
0f539b13 11no warnings 'experimental::smartmatch';
0d863452
RH
12
13use Tie::Array;
14use Tie::Hash;
15
0d863452 16# Predeclare vars used in the tests:
031a44ed
RGS
17my @empty;
18my %empty;
015eb7b9 19my @sparse; $sparse[2] = 2;
031a44ed 20
1144115d
RGS
21my $deep1 = []; push @$deep1, $deep1;
22my $deep2 = []; push @$deep2, $deep2;
0d863452 23
0d863452
RH
24my @nums = (1..10);
25tie my @tied_nums, 'Tie::StdArray';
26@tied_nums = (1..10);
27
28my %hash = (foo => 17, bar => 23);
29tie 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 59our $ov_obj = Test::Object::WithOverload->new;
6fbc735b 60our $ov_obj_2 = Test::Object::WithOverload->new("object");
1cfb7049 61our $obj = Test::Object::NoOverload->new;
6fbc735b 62our $str_obj = Test::Object::StringOverload->new;
1cfb7049 63
c5836baf 64my %refh;
d3d1232e
NC
65unless (is_miniperl()) {
66 require Tie::RefHash;
c5836baf
RGS
67 tie %refh, 'Tie::RefHash';
68 $refh{$ov_obj} = 1;
69}
b15feb55 70
73aec0b1
RGS
71my @keyandmore = qw(key and more);
72my @fooormore = qw(foo or more);
73my %keyandmore = map { $_ => 0 } @keyandmore;
74my %fooormore = map { $_ => 0 } @fooormore;
75
0d863452 76# Load and run the tests
b900a653 77plan tests => 349;
0d863452 78
9e079ace 79while (<DATA>) {
c5836baf 80 SKIP: {
9e079ace
RGS
81 next if /^#/ || !/\S/;
82 chomp;
73aec0b1 83 my ($yn, $left, $right, $note) = split /\t+/;
0d863452 84
73aec0b1 85 local $::TODO = $note =~ /TODO/;
0d863452 86
85af77a5 87 die "Bad test spec: ($yn, $left, $right)" if $yn =~ /[^!@=]/;
9e079ace 88
0d863452 89 my $tstr = "$left ~~ $right";
9e079ace 90
85af77a5 91 test_again:
289d21b2
RGS
92 my $res;
93 if ($note =~ /NOWARNINGS/) {
94 $res = eval "no warnings; $tstr";
95 }
96 else {
d3d1232e
NC
97 skip_if_miniperl("Doesn't work with miniperl", $yn =~ /=/ ? 2 : 1)
98 if $note =~ /MINISKIP/;
289d21b2
RGS
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 124sub foo {}
73aec0b1
RGS
125sub bar {42}
126sub gorch {42}
1cfb7049 127sub fatal {die "fatal sub\n"}
0d863452 128
0cfbf1ea 129# to test constant folding
18d11902
RGS
130sub FALSE() { 0 }
131sub TRUE() { 1 }
2522c35a 132sub 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:
6fbc735b 227
ad0781bc 228# object (overloaded or not) ~~ Any
0483c672
RGS
229 $obj qr/NoOverload/
230 $ov_obj qr/^stringified$/
532217f1 231= "$ov_obj" "stringified"
6fbc735b 232= "$str_obj" "object"
532217f1 233!= $ov_obj "stringified"
6fbc735b 234 $str_obj "object"
2c9d2554
RGS
235 $ov_obj 'magic'
236! $ov_obj 'not magic'
1cfb7049 237
a4a197da
RGS
238# ~~ Coderef
239 sub{0} sub { ref $_[0] eq "CODE" }
240 %fooormore sub { $_[0] =~ /^(foo|or|more)$/ }
241! %fooormore sub { $_[0] =~ /^(foo|or|less)$/ }
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{@_==1}
253 @fooormore sub{@_==1}
254 "foo" sub { $_[0] =~ /^(foo|or|more)$/ }
255! "more" sub { $_[0] =~ /^(foo|or|less)$/ }
73aec0b1 256 /fooormore/ sub{ref $_[0] eq 'Regexp'}
a4a197da
RGS
257 qr/fooormore/ sub{ref $_[0] eq 'Regexp'}
258 1 sub{shift}
259! 0 sub{shift}
260! undef sub{shift}
261 undef sub{not shift}
031a44ed
RGS
262 NOT_DEF sub{not shift}
263 &NOT_DEF sub{not shift}
a4a197da
RGS
264 FALSE sub{not shift}
265 [1] \&bar
266 {a=>1} \&bar
267 qr// \&bar
268! [1] \&foo
269! {a=>1} \&foo
41e726ac 270 $obj sub { ref($_[0]) =~ /NoOverload/ }
90a32bcb 271 $ov_obj sub { ref($_[0]) =~ /WithOverload/ }
a4a197da 272# empty stuff matches, because the sub is never called:
07edf497
RGS
273 [] \&foo
274 {} \&foo
031a44ed
RGS
275 @empty \&foo
276 %empty \&foo
a4a197da
RGS
277! qr// \&foo
278! undef \&foo
279 undef \&bar
280@ undef \&fatal
281@ 1 \&fatal
282@ [1] \&fatal
203d1e89 283@ {a=>1} \&fatal
a4a197da
RGS
284@ "foo" \&fatal
285@ qr// \&fatal
203d1e89 286# sub is not called on empty hashes / arrays
07edf497
RGS
287 [] \&fatal
288 +{} \&fatal
031a44ed
RGS
289 @empty \&fatal
290 %empty \&fatal
532217f1
RGS
291# sub is not special on the left
292 sub {0} qr/^CODE/
293 sub {0} sub { ref shift eq "CODE" }
0d863452 294
0d863452
RH
295# HASH ref against:
296# - another hash ref
297 {} {}
2a37c5e7 298=! {} {1 => 2}
0d863452
RH
299 {1 => 2} {1 => 2}
300 {1 => 2} {1 => 3}
031a44ed
RGS
301=! {1 => 2} {2 => 3}
302= \%main:: {map {$_ => 'x'} keys %main::}
0d863452
RH
303
304# - tied hash ref
2522c35a 305= \%hash \%tied_hash
0d863452 306 \%tied_hash \%tied_hash
031a44ed
RGS
307!= {"a"=>"b"} \%tied_hash
308= %hash %tied_hash
309 %tied_hash %tied_hash
310!= {"a"=>"b"} %tied_hash
c5836baf
RGS
311 $ov_obj %refh MINISKIP
312! "$ov_obj" %refh MINISKIP
313 [$ov_obj] %refh MINISKIP
314! ["$ov_obj"] %refh MINISKIP
315 %refh %refh MINISKIP
0d863452
RH
316
317# - an array ref
031a44ed
RGS
318# (since this is symmetrical, tests as well hash~~array)
319= [keys %main::] \%::
320= [qw[STDIN STDOUT]] \%::
321=! [] \%::
322=! [""] {}
323=! [] {}
324=! @empty {}
325= [undef] {"" => 1}
326= [""] {"" => 1}
327= ["foo"] { foo => 1 }
328= ["foo", "bar"] { foo => 1 }
329= ["foo", "bar"] \%hash
330= ["foo"] \%hash
331=! ["quux"] \%hash
332= [qw(foo quux)] \%hash
333= @fooormore { foo => 1, or => 2, more => 3 }
334= @fooormore %fooormore
335= @fooormore \%fooormore
336= \@fooormore %fooormore
0d863452
RH
337
338# - a regex
ea0c2dbd
RGS
339= qr/^(fo[ox])$/ {foo => 1}
340= /^(fo[ox])$/ %fooormore
031a44ed 341=! qr/[13579]$/ +{0..99}
ea0c2dbd 342=! qr/a*/ {}
031a44ed 343= qr/a*/ {b=>2}
ea0c2dbd
RGS
344= qr/B/i {b=>2}
345= /B/i {b=>2}
346=! qr/a+/ {b=>2}
347= qr/^à/ {"à"=>2}
0d863452 348
031a44ed 349# - a scalar
2e0e16c9 350 "foo" +{foo => 1, bar => 2}
031a44ed 351 "foo" %fooormore
2e0e16c9 352! "baz" +{foo => 1, bar => 2}
031a44ed
RGS
353! "boz" %fooormore
354! 1 +{foo => 1, bar => 2}
355! 1 %fooormore
356 1 { 1 => 3 }
357 1.0 { 1 => 3 }
358! "1.0" { 1 => 3 }
359! "1.0" { 1.0 => 3 }
360 "1.0" { "1.0" => 3 }
361 "à" { "à" => "À" }
0d863452 362
61a621c6 363# - undef
2522c35a 364! undef { hop => 'zouu' }
61a621c6
RGS
365! undef %hash
366! undef +{"" => "empty key"}
2a37c5e7 367! undef {}
0d863452
RH
368
369# ARRAY ref against:
370# - another array ref
1cfb7049 371 [] []
2522c35a 372=! [] [1]
ea0c2dbd
RGS
373 [["foo"], ["bar"]] [qr/o/, qr/a/]
374! [["foo"], ["bar"]] [qr/ARRAY/, qr/ARRAY/]
0d863452 375 ["foo", "bar"] [qr/o/, qr/a/]
031a44ed 376! [qr/o/, qr/a/] ["foo", "bar"]
2522c35a 377 ["foo", "bar"] [["foo"], ["bar"]]
71b0fb34 378! ["foo", "bar"] [qr/o/, "foo"]
2522c35a 379 ["foo", undef, "bar"] [qr/o/, undef, "bar"]
fb51372e 380! ["foo", undef, "bar"] [qr/o/, "", "bar"]
2522c35a 381! ["foo", "", "bar"] [qr/o/, undef, "bar"]
1cfb7049 382 $deep1 $deep1
031a44ed 383 @$deep1 @$deep1
1cfb7049 384! $deep1 $deep2
0d863452 385
031a44ed
RGS
386= \@nums \@tied_nums
387= @nums \@tied_nums
388= \@nums @tied_nums
389= @nums @tied_nums
390
d0b243e3
RGS
391# - an object
392! $obj @fooormore
41e726ac 393 $obj [sub{ref shift}]
d0b243e3 394
0d863452 395# - a regex
ea0c2dbd
RGS
396= qr/x/ [qw(foo bar baz quux)]
397=! qr/y/ [qw(foo bar baz quux)]
398= /x/ [qw(foo bar baz quux)]
399=! /y/ [qw(foo bar baz quux)]
400= /FOO/i @fooormore
401=! /bar/ @fooormore
0d863452
RH
402
403# - a number
015eb7b9 404 2 [qw(1.00 2.00)]
b0138e99
RGS
405 2 [qw(foo 2)]
406 2.0_0e+0 [qw(foo 2)]
407! 2 [qw(1foo bar2)]
0d863452
RH
408
409# - a string
b0138e99
RGS
410! "2" [qw(1foo 2bar)]
411 "2bar" [qw(1foo 2bar)]
0d863452 412
015eb7b9
RGS
413# - undef
414 undef [1, 2, undef, 4]
415! undef [1, 2, [undef], 4]
416! undef @fooormore
417 undef @sparse
fb51372e
RGS
418 undef [undef]
419! 0 [undef]
420! "" [undef]
421! undef [0]
422! undef [""]
015eb7b9
RGS
423
424# - nested arrays and ~~ distributivity
425 11 [[11]]
426! 11 [[12]]
427 "foo" [{foo => "bar"}]
428! "bar" [{foo => "bar"}]
429
0d863452
RH
430# Number against number
431 2 2
33ed63a2 432 20 2_0
0d863452 433! 2 3
18d11902
RGS
434 0 FALSE
435 3-2 TRUE
fb51372e
RGS
436! undef 0
437! (my $u) 0
0d863452
RH
438
439# Number against string
33ed63a2
RGS
440= 2 "2"
441= 2 "2.0"
0d863452 442! 2 "2bananas"
289d21b2 443!= 2_3 "2_3" NOWARNINGS
18d11902 444 FALSE "0"
fb51372e
RGS
445! undef "0"
446! undef ""
0d863452
RH
447
448# Regex against string
a566f585
RGS
449 "x" qr/x/
450! "x" qr/y/
0d863452
RH
451
452# Regex against number
453 12345 qr/3/
2522c35a 454! 12345 qr/7/
0d863452 455
031a44ed 456# array/hash against string
d444f7e3
RGS
457 @fooormore "".\@fooormore
458! @keyandmore "".\@fooormore
459 %fooormore "".\%fooormore
460! %keyandmore "".\%fooormore
f1bef09e 461
0d863452 462# Test the implicit referencing
b0138e99 463 7 @nums
0d863452
RH
464 @nums \@nums
465! @nums \\@nums
466 @nums [1..10]
467! @nums [0..9]
468
2e0e16c9
RGS
469 "foo" %hash
470 /bar/ %hash
471 [qw(bar)] %hash
472! [qw(a b c)] %hash
71b0fb34 473 %hash %hash
fceebc47 474 %hash +{%hash}
73aec0b1 475 %hash \%hash
71b0fb34
DK
476 %hash %tied_hash
477 %tied_hash %tied_hash
478 %hash { foo => 5, bar => 10 }
479! %hash { foo => 5, bar => 10, quux => 15 }
480
481 @nums { 1, '', 2, '' }
482 @nums { 1, '', 12, '' }
483! @nums { 11, '', 12, '' }
be99ef1a 484
329a333e
DL
485# array slices
486 @nums[0..-1] []
487 @nums[0..0] [1]
488! @nums[0..1] [0..2]
489 @nums[0..4] [1..5]
490
491! undef @nums[0..-1]
492 1 @nums[0..0]
493 2 @nums[0..1]
494! @nums[0..1] 2
495
496 @nums[0..1] @nums[0..1]
497
498# hash slices
499 @keyandmore{qw(not)} [undef]
500 @keyandmore{qw(key)} [0]
501
502 undef @keyandmore{qw(not)}
503 0 @keyandmore{qw(key and more)}
504! 2 @keyandmore{qw(key and)}
505
506 @fooormore{qw(foo)} @keyandmore{qw(key)}
507 @fooormore{qw(foo or more)} @keyandmore{qw(key and more)}
508
be99ef1a
YK
509# UNDEF
510! 3 undef
511! 1 undef
512! [] undef
513! {} undef
514! \%::main undef
515! [1,2] undef
516! %hash undef
517! @nums undef
518! "foo" undef
519! "" undef
520! !1 undef
521! \&foo undef
522! sub { } undef