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