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