Inline macros used only once
[p5sagit/p5-mst-13.2.git] / t / op / smartmatch.t
CommitLineData
0d863452 1#!./perl
2
3BEGIN {
4 chdir 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8use strict;
9
10use Tie::Array;
11use Tie::Hash;
12
0d863452 13# Predeclare vars used in the tests:
031a44ed 14my @empty;
15my %empty;
16
0d863452 17my $deep1 = []; push @$deep1, \$deep1;
18my $deep2 = []; push @$deep2, \$deep2;
19
0d863452 20my @nums = (1..10);
21tie my @tied_nums, 'Tie::StdArray';
22@tied_nums = (1..10);
23
24my %hash = (foo => 17, bar => 23);
25tie 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 39our $ov_obj = Test::Object::CopyOverload->new;
40our $obj = Test::Object::NoOverload->new;
1cfb7049 41
73aec0b1 42my @keyandmore = qw(key and more);
43my @fooormore = qw(foo or more);
44my %keyandmore = map { $_ => 0 } @keyandmore;
45my %fooormore = map { $_ => 0 } @fooormore;
46
0d863452 47# Load and run the tests
9e079ace 48plan "no_plan";
0d863452 49
9e079ace 50while (<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 85sub foo {}
73aec0b1 86sub bar {42}
87sub gorch {42}
1cfb7049 88sub fatal {die "fatal sub\n"}
0d863452 89
0cfbf1ea 90# to test constant folding
18d11902 91sub FALSE() { 0 }
92sub TRUE() { 1 }
2522c35a 93sub 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
6d743019 153@ $ov_obj $obj
ad0781bc 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, '' }