This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test preamble: unify chdir 't' if -d 't';
[perl5.git] / t / op / smartmatch.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8 use strict;
9 use warnings;
10 no warnings 'uninitialized';
11 no warnings 'experimental::smartmatch';
12
13 use Tie::Array;
14 use Tie::Hash;
15
16 # Predeclare vars used in the tests:
17 my @empty;
18 my %empty;
19 my @sparse; $sparse[2] = 2;
20
21 my $deep1 = []; push @$deep1, $deep1;
22 my $deep2 = []; push @$deep2, $deep2;
23
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
32 {
33     package Test::Object::NoOverload;
34     sub new { bless { key => 1 } }
35 }
36
37 {
38     package Test::Object::StringOverload;
39     use overload '""' => sub { "object" }, fallback => 1;
40     sub new { bless { key => 1 } }
41 }
42
43 {
44     package Test::Object::WithOverload;
45     sub new { bless { key => ($_[1] // 'magic') } }
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     };
55     use overload '""' => sub { "stringified" };
56     use overload 'eq' => sub {"$_[0]" eq "$_[1]"};
57 }
58
59 our $ov_obj = Test::Object::WithOverload->new;
60 our $ov_obj_2 = Test::Object::WithOverload->new("object");
61 our $obj = Test::Object::NoOverload->new;
62 our $str_obj = Test::Object::StringOverload->new;
63
64 my %refh;
65 unless (is_miniperl()) {
66     require Tie::RefHash;
67     tie %refh, 'Tie::RefHash';
68     $refh{$ov_obj} = 1;
69 }
70
71 my @keyandmore = qw(key and more);
72 my @fooormore = qw(foo or more);
73 my %keyandmore = map { $_ => 0 } @keyandmore;
74 my %fooormore = map { $_ => 0 } @fooormore;
75
76 # Load and run the tests
77 plan tests => 349;
78
79 while (<DATA>) {
80   SKIP: {
81     next if /^#/ || !/\S/;
82     chomp;
83     my ($yn, $left, $right, $note) = split /\t+/;
84
85     local $::TODO = $note =~ /TODO/;
86
87     die "Bad test spec: ($yn, $left, $right)" if $yn =~ /[^!@=]/;
88
89     my $tstr = "$left ~~ $right";
90
91     test_again:
92     my $res;
93     if ($note =~ /NOWARNINGS/) {
94         $res = eval "no warnings; $tstr";
95     }
96     else {
97         skip_if_miniperl("Doesn't work with miniperl", $yn =~ /=/ ? 2 : 1)
98             if $note =~ /MINISKIP/;
99         $res = eval $tstr;
100     }
101
102     chomp $@;
103
104     if ( $yn =~ /@/ ) {
105         ok( $@ ne '', "$tstr dies" )
106             and print "# \$\@ was: $@\n";
107     } else {
108         my $test_name = $tstr . ($yn =~ /!/ ? " does not match" : " matches");
109         if ( $@ ne '' ) {
110             fail($test_name);
111             print "# \$\@ was: $@\n";
112         } else {
113             ok( ($yn =~ /!/ xor $res), $test_name );
114         }
115     }
116
117     if ( $yn =~ s/=// ) {
118         $tstr = "$right ~~ $left";
119         goto test_again;
120     }
121   }
122 }
123
124 sub foo {}
125 sub bar {42}
126 sub gorch {42}
127 sub fatal {die "fatal sub\n"}
128
129 # to test constant folding
130 sub FALSE() { 0 }
131 sub TRUE() { 1 }
132 sub NOT_DEF() { undef }
133
134 # Prefix character :
135 #   - expected to match
136 # ! - expected to not match
137 # @ - expected to be a compilation failure
138 # = - expected to match symmetrically (runs test twice)
139 # Data types to test :
140 #   undef
141 #   Object-overloaded
142 #   Object
143 #   Coderef
144 #   Hash
145 #   Hashref
146 #   Array
147 #   Arrayref
148 #   Tied arrays and hashes
149 #   Arrays that reference themselves
150 #   Regex (// and qr//)
151 #   Range
152 #   Num
153 #   Str
154 # Other syntactic items of interest:
155 #   Constants
156 #   Values returned by a sub call
157 __DATA__
158 # Any ~~ undef
159 !       $ov_obj         undef
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
179         (my $u)         undef
180         NOT_DEF         undef
181         &NOT_DEF        undef
182
183 # Any ~~ object overloaded
184 !       \&fatal         $ov_obj
185         'cigam'         $ov_obj
186 !       'cigam on'      $ov_obj
187 !       ['cigam']       $ov_obj
188 !       ['stringified'] $ov_obj
189 !       { cigam => 1 }  $ov_obj
190 !       { stringified => 1 }    $ov_obj
191 !       $obj            $ov_obj
192 !       undef           $ov_obj
193
194 # regular object
195 @       $obj            $obj
196 @       $ov_obj         $obj
197 =@      \&fatal         $obj
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
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
228 # object (overloaded or not) ~~ Any
229         $obj            qr/NoOverload/
230         $ov_obj         qr/^stringified$/
231 =       "$ov_obj"       "stringified"
232 =       "$str_obj"      "object"
233 !=      $ov_obj         "stringified"
234         $str_obj        "object"
235         $ov_obj         'magic'
236 !       $ov_obj         'not magic'
237
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)$/ }
256         /fooormore/     sub{ref $_[0] eq 'Regexp'}
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}
262         NOT_DEF         sub{not shift}
263         &NOT_DEF        sub{not shift}
264         FALSE           sub{not shift}
265         [1]             \&bar
266         {a=>1}          \&bar
267         qr//            \&bar
268 !       [1]             \&foo
269 !       {a=>1}          \&foo
270         $obj            sub { ref($_[0]) =~ /NoOverload/ }
271         $ov_obj         sub { ref($_[0]) =~ /WithOverload/ }
272 # empty stuff matches, because the sub is never called:
273         []              \&foo
274         {}              \&foo
275         @empty          \&foo
276         %empty          \&foo
277 !       qr//            \&foo
278 !       undef           \&foo
279         undef           \&bar
280 @       undef           \&fatal
281 @       1               \&fatal
282 @       [1]             \&fatal
283 @       {a=>1}          \&fatal
284 @       "foo"           \&fatal
285 @       qr//            \&fatal
286 # sub is not called on empty hashes / arrays
287         []              \&fatal
288         +{}             \&fatal
289         @empty          \&fatal
290         %empty          \&fatal
291 # sub is not special on the left
292         sub {0}         qr/^CODE/
293         sub {0}         sub { ref shift eq "CODE" }
294
295 # HASH ref against:
296 #   - another hash ref
297         {}              {}
298 =!      {}              {1 => 2}
299         {1 => 2}        {1 => 2}
300         {1 => 2}        {1 => 3}
301 =!      {1 => 2}        {2 => 3}
302 =       \%main::        {map {$_ => 'x'} keys %main::}
303
304 #  - tied hash ref
305 =       \%hash          \%tied_hash
306         \%tied_hash     \%tied_hash
307 !=      {"a"=>"b"}      \%tied_hash
308 =       %hash           %tied_hash
309         %tied_hash      %tied_hash
310 !=      {"a"=>"b"}      %tied_hash
311         $ov_obj         %refh           MINISKIP
312 !       "$ov_obj"       %refh           MINISKIP
313         [$ov_obj]       %refh           MINISKIP
314 !       ["$ov_obj"]     %refh           MINISKIP
315         %refh           %refh           MINISKIP
316
317 #  - an array ref
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
337
338 #  - a regex
339 =       qr/^(fo[ox])$/          {foo => 1}
340 =       /^(fo[ox])$/            %fooormore
341 =!      qr/[13579]$/            +{0..99}
342 =!      qr/a*/                  {}
343 =       qr/a*/                  {b=>2}
344 =       qr/B/i                  {b=>2}
345 =       /B/i                    {b=>2}
346 =!      qr/a+/                  {b=>2}
347 =       qr/^à/                 {"à"=>2}
348
349 #  - a scalar
350         "foo"           +{foo => 1, bar => 2}
351         "foo"           %fooormore
352 !       "baz"           +{foo => 1, bar => 2}
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         "à"            { "à" => "À" }
362
363 #  - undef
364 !       undef           { hop => 'zouu' }
365 !       undef           %hash
366 !       undef           +{"" => "empty key"}
367 !       undef           {}
368
369 # ARRAY ref against:
370 #  - another array ref
371         []                      []
372 =!      []                      [1]
373         [["foo"], ["bar"]]      [qr/o/, qr/a/]
374 !       [["foo"], ["bar"]]      [qr/ARRAY/, qr/ARRAY/]
375         ["foo", "bar"]          [qr/o/, qr/a/]
376 !       [qr/o/, qr/a/]          ["foo", "bar"]
377         ["foo", "bar"]          [["foo"], ["bar"]]
378 !       ["foo", "bar"]          [qr/o/, "foo"]
379         ["foo", undef, "bar"]   [qr/o/, undef, "bar"]
380 !       ["foo", undef, "bar"]   [qr/o/, "",    "bar"]
381 !       ["foo", "", "bar"]      [qr/o/, undef, "bar"]
382         $deep1                  $deep1
383         @$deep1                 @$deep1
384 !       $deep1                  $deep2
385
386 =       \@nums                  \@tied_nums
387 =       @nums                   \@tied_nums
388 =       \@nums                  @tied_nums
389 =       @nums                   @tied_nums
390
391 #  - an object
392 !       $obj            @fooormore
393         $obj            [sub{ref shift}]
394
395 #  - a regex
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
402
403 # - a number
404         2               [qw(1.00 2.00)]
405         2               [qw(foo 2)]
406         2.0_0e+0        [qw(foo 2)]
407 !       2               [qw(1foo bar2)]
408
409 # - a string
410 !       "2"             [qw(1foo 2bar)]
411         "2bar"          [qw(1foo 2bar)]
412
413 # - undef
414         undef           [1, 2, undef, 4]
415 !       undef           [1, 2, [undef], 4]
416 !       undef           @fooormore
417         undef           @sparse
418         undef           [undef]
419 !       0               [undef]
420 !       ""              [undef]
421 !       undef           [0]
422 !       undef           [""]
423
424 # - nested arrays and ~~ distributivity
425         11              [[11]]
426 !       11              [[12]]
427         "foo"           [{foo => "bar"}]
428 !       "bar"           [{foo => "bar"}]
429
430 # Number against number
431         2               2
432         20              2_0
433 !       2               3
434         0               FALSE
435         3-2             TRUE
436 !       undef           0
437 !       (my $u)         0
438
439 # Number against string
440 =       2               "2"
441 =       2               "2.0"
442 !       2               "2bananas"
443 !=      2_3             "2_3"           NOWARNINGS
444         FALSE           "0"
445 !       undef           "0"
446 !       undef           ""
447
448 # Regex against string
449         "x"             qr/x/
450 !       "x"             qr/y/
451
452 # Regex against number
453         12345           qr/3/
454 !       12345           qr/7/
455
456 # array/hash against string
457         @fooormore      "".\@fooormore
458 !       @keyandmore     "".\@fooormore
459         %fooormore      "".\%fooormore
460 !       %keyandmore     "".\%fooormore
461
462 # Test the implicit referencing
463         7               @nums
464         @nums           \@nums
465 !       @nums           \\@nums
466         @nums           [1..10]
467 !       @nums           [0..9]
468
469         "foo"           %hash
470         /bar/           %hash
471         [qw(bar)]       %hash
472 !       [qw(a b c)]     %hash
473         %hash           %hash
474         %hash           +{%hash}
475         %hash           \%hash
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, '' }
484
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
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