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