This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement Hash/Array ~~ Regex (with tests)
[perl5.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
10 use Tie::Array;
11 use Tie::Hash;
12
13 # Predeclare vars used in the tests:
14 my @empty;
15 my %empty;
16 my @sparse; $sparse[2] = 2;
17
18 my $deep1 = []; push @$deep1, \$deep1;
19 my $deep2 = []; push @$deep2, \$deep2;
20
21 my @nums = (1..10);
22 tie my @tied_nums, 'Tie::StdArray';
23 @tied_nums =  (1..10);
24
25 my %hash = (foo => 17, bar => 23);
26 tie my %tied_hash, 'Tie::StdHash';
27 %tied_hash = %hash;
28
29 {
30     package Test::Object::NoOverload;
31     sub new { bless { key => 1 } }
32 }
33
34 {
35     package Test::Object::WithOverload;
36     sub new { bless { key => 'magic' } }
37     use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] eq $hash{key} };
38     use overload '""' => sub { "stringified" };
39     use overload 'eq' => sub {"$_[0]" eq "$_[1]"};
40 }
41
42 our $ov_obj = Test::Object::WithOverload->new;
43 our $obj = Test::Object::NoOverload->new;
44
45 my @keyandmore = qw(key and more);
46 my @fooormore = qw(foo or more);
47 my %keyandmore = map { $_ => 0 } @keyandmore;
48 my %fooormore = map { $_ => 0 } @fooormore;
49
50 # Load and run the tests
51 plan "no_plan";
52
53 while (<DATA>) {
54     next if /^#/ || !/\S/;
55     chomp;
56     my ($yn, $left, $right, $note) = split /\t+/;
57
58     local $::TODO = $note =~ /TODO/;
59
60     die "Bad test spec: ($yn, $left, $right)" if $yn =~ /[^!@=]/;
61
62     my $tstr = "$left ~~ $right";
63
64     test_again:
65     my $res = eval $tstr;
66
67     chomp $@;
68
69     if ( $yn =~ /@/ ) {
70         ok( $@ ne '', "$tstr dies" )
71             and print "# \$\@ was: $@\n";
72     } else {
73         my $test_name = $tstr . ($yn =~ /!/ ? " does not match" : " matches");
74         if ( $@ ne '' ) {
75             fail($test_name);
76             print "# \$\@ was: $@\n";
77         } else {
78             ok( ($yn =~ /!/ xor $res), $test_name );
79         }
80     }
81
82     if ( $yn =~ s/=// ) {
83         $tstr = "$right ~~ $left";
84         goto test_again;
85     }
86 }
87
88 sub foo {}
89 sub bar {42}
90 sub gorch {42}
91 sub fatal {die "fatal sub\n"}
92
93 # to test constant folding
94 sub FALSE() { 0 }
95 sub TRUE() { 1 }
96 sub NOT_DEF() { undef }
97
98 # Prefix character :
99 #   - expected to match
100 # ! - expected to not match
101 # @ - expected to be a compilation failure
102 # = - expected to match symmetrically (runs test twice)
103 # Data types to test :
104 #   undef
105 #   Object-overloaded
106 #   Object
107 #   Coderef
108 #   Hash
109 #   Hashref
110 #   Array
111 #   Arrayref
112 #   Tied arrays and hashes
113 #   Arrays that reference themselves
114 #   Regex (// and qr//)
115 #   Range
116 #   Num
117 #   Str
118 # Other syntactic items of interest:
119 #   Constants
120 #   Values returned by a sub call
121 __DATA__
122 # Any ~~ undef
123 !       $ov_obj         undef
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
143         (my $u)         undef
144         NOT_DEF         undef
145         &NOT_DEF        undef
146
147 # Any ~~ object overloaded
148 !       \&fatal         $ov_obj
149         'magic'         $ov_obj
150 !       'not magic'     $ov_obj
151 !       $obj            $ov_obj
152 !       undef           $ov_obj
153
154 # regular object
155 @       $obj            $obj
156 @       $ov_obj         $obj
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
172         $obj            qr/NoOverload/
173         $ov_obj         qr/^stringified$/
174         $ov_obj         "stringified"
175
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)$/ }
194         /fooormore/     sub{ref $_[0] eq 'Regexp'}
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}
200         NOT_DEF         sub{not shift}
201         &NOT_DEF        sub{not shift}
202         FALSE           sub{not shift}
203         [1]             \&bar
204         {a=>1}          \&bar
205         qr//            \&bar
206 !       [1]             \&foo
207 !       {a=>1}          \&foo
208         $obj            sub { ref($_[0]) =~ /NoOverload/ }
209         $ov_obj         sub { ref($_[0]) =~ /WithOverload/ }
210 # empty stuff matches, because the sub is never called:
211         []              \&foo
212         {}              \&foo
213         @empty          \&foo
214         %empty          \&foo
215 !       qr//            \&foo
216 !       undef           \&foo
217         undef           \&bar
218 @       undef           \&fatal
219 @       1               \&fatal
220 @       [1]             \&fatal
221 @       {a=>1}          \&fatal
222 @       "foo"           \&fatal
223 @       qr//            \&fatal
224 # sub is not called on empty hashes / arrays
225         []              \&fatal
226         +{}             \&fatal
227         @empty          \&fatal
228         %empty          \&fatal
229
230 # HASH ref against:
231 #   - another hash ref
232         {}              {}
233 =!      {}              {1 => 2}
234         {1 => 2}        {1 => 2}
235         {1 => 2}        {1 => 3}
236 =!      {1 => 2}        {2 => 3}
237 =       \%main::        {map {$_ => 'x'} keys %main::}
238
239 #  - tied hash ref
240 =       \%hash          \%tied_hash
241         \%tied_hash     \%tied_hash
242 !=      {"a"=>"b"}      \%tied_hash
243 =       %hash           %tied_hash
244         %tied_hash      %tied_hash
245 !=      {"a"=>"b"}      %tied_hash
246
247 #  - an array ref
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
267
268 #  - a regex
269 =       qr/^(fo[ox])$/          {foo => 1}
270 =       /^(fo[ox])$/            %fooormore
271 =!      qr/[13579]$/            +{0..99}
272 =!      qr/a*/                  {}
273 =       qr/a*/                  {b=>2}
274 =       qr/B/i                  {b=>2}
275 =       /B/i                    {b=>2}
276 =!      qr/a+/                  {b=>2}
277 =       qr/^à/                 {"à"=>2}
278
279 #  - a scalar
280         "foo"           +{foo => 1, bar => 2}
281         "foo"           %fooormore
282 !       "baz"           +{foo => 1, bar => 2}
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         "à"            { "à" => "À" }
292
293 #  - undef
294 !       undef           { hop => 'zouu' }
295 !       undef           %hash
296 !       undef           +{"" => "empty key"}
297 !       undef           {}
298
299 # ARRAY ref against:
300 #  - another array ref
301         []                      []
302 =!      []                      [1]
303         [["foo"], ["bar"]]      [qr/o/, qr/a/]
304 !       [["foo"], ["bar"]]      [qr/ARRAY/, qr/ARRAY/]
305         ["foo", "bar"]          [qr/o/, qr/a/]
306 !       [qr/o/, qr/a/]          ["foo", "bar"]
307         ["foo", "bar"]          [["foo"], ["bar"]]
308 !       ["foo", "bar"]          [qr/o/, "foo"]
309         ["foo", undef, "bar"]   [qr/o/, undef, "bar"]
310         ["foo", undef, "bar"]   [qr/o/, "",    "bar"]
311 !       ["foo", "", "bar"]      [qr/o/, undef, "bar"]
312         $deep1                  $deep1
313         @$deep1                 @$deep1
314 !       $deep1                  $deep2
315
316 =       \@nums                  \@tied_nums
317 =       @nums                   \@tied_nums
318 =       \@nums                  @tied_nums
319 =       @nums                   @tied_nums
320
321 #  - an object
322 !       $obj            @fooormore
323         $obj            [sub{ref shift}]
324
325 #  - works with lists instead of arrays
326         "foo"                   qw(foo bar)     TODO
327         "foo"                   ('foo','bar')   TODO
328
329 #  - a regex
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
336
337 # - a number
338         2               [qw(1.00 2.00)]
339         2               [qw(foo 2)]
340         2.0_0e+0        [qw(foo 2)]
341 !       2               [qw(1foo bar2)]
342
343 # - a string
344 !       "2"             [qw(1foo 2bar)]
345         "2bar"          [qw(1foo 2bar)]
346
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
359 # Number against number
360         2               2
361         20              2_0
362 !       2               3
363         0               FALSE
364         3-2             TRUE
365         undef           0
366
367 # Number against string
368 =       2               "2"
369 =       2               "2.0"
370 !       2               "2bananas"
371 !=      2_3             "2_3"
372         FALSE           "0"
373
374 # Regex against string
375         "x"             qr/x/
376 !       "x"             qr/y/
377
378 # Regex against number
379         12345           qr/3/
380 !       12345           qr/7/
381
382 # TODO ranges
383
384 # array/hash against string
385         @fooormore      "".\@fooormore
386 !       @keyandmore     "".\@fooormore
387         %fooormore      "".\%fooormore
388 !       %keyandmore     "".\%fooormore
389
390 # Test the implicit referencing
391         7               @nums
392         @nums           \@nums
393 !       @nums           \\@nums
394         @nums           [1..10]
395 !       @nums           [0..9]
396
397         "foo"           %hash
398         /bar/           %hash
399         [qw(bar)]       %hash
400 !       [qw(a b c)]     %hash
401         %hash           %hash
402         %hash           +{%hash}
403         %hash           \%hash
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, '' }