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