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