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