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