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 | match_test($yn, $left, $right); |
54 | match_test($yn, $right, $left); |
55 | } |
56 | |
57 | sub match_test { |
58 | my ($yn, $left, $right) = @_; |
59 | |
60 | die "Bad test spec: ($yn, $left, $right)" |
a86f5011 |
61 | unless $yn eq "" || $yn eq "!" || $yn eq '@'; |
9e079ace |
62 | |
0d863452 |
63 | my $tstr = "$left ~~ $right"; |
9e079ace |
64 | |
65 | my $res = eval $tstr; |
0d863452 |
66 | |
a86f5011 |
67 | chomp $@; |
68 | |
69 | if ( $yn eq '@' ) { |
9e079ace |
70 | ok( $@ ne '', "$tstr dies" ) |
71 | and print "# \$\@ was: $@\n"; |
a86f5011 |
72 | } else { |
9e079ace |
73 | my $test_name = $tstr . ($yn eq '!' ? " does not match" : " matches"); |
a86f5011 |
74 | if ( $@ ne '' ) { |
9e079ace |
75 | fail($test_name); |
76 | print "# \$\@ was: $@\n"; |
a86f5011 |
77 | } else { |
9e079ace |
78 | ok( ($yn eq '!' xor $res), $test_name ); |
a86f5011 |
79 | } |
80 | } |
0d863452 |
81 | } |
82 | |
83 | |
84 | |
85 | sub foo {} |
73aec0b1 |
86 | sub bar {42} |
87 | sub gorch {42} |
1cfb7049 |
88 | sub fatal {die "fatal sub\n"} |
0d863452 |
89 | |
1cfb7049 |
90 | sub a_const() {die "const\n" if @_; "a constant"} |
91 | sub b_const() {die "const\n" if @_; "a constant"} |
18d11902 |
92 | sub FALSE() { 0 } |
93 | sub TRUE() { 1 } |
94 | sub TWO() { 1 } |
0d863452 |
95 | |
e5de85fa |
96 | # Prefix character : |
97 | # - expected to match |
98 | # ! - expected to not match |
99 | # @ - expected to be a compilation failure |
73aec0b1 |
100 | # Data types to test : |
101 | # Object-overloaded |
102 | # Object |
103 | # Code |
104 | # Code() |
105 | # Coderef |
106 | # Hash |
107 | # Hashref |
108 | # Array |
109 | # Arrayref |
110 | # Regex (// and qr//) |
111 | # Num |
112 | # Str |
113 | # undef |
0d863452 |
114 | __DATA__ |
1cfb7049 |
115 | # OBJECT |
116 | # - overloaded |
117 | $ov_obj "key" |
1cfb7049 |
118 | ! $ov_obj "foo" |
4cbab0e9 |
119 | $ov_obj {"key" => 1} |
73aec0b1 |
120 | $ov_obj {"key" => 1, bar => 2} TODO |
4cbab0e9 |
121 | ! $ov_obj {"foo" => 1} |
122 | $ov_obj ["key" => 1] |
123 | ! $ov_obj ["foo" => 1] |
73aec0b1 |
124 | $ov_obj @keyandmore |
125 | ! $ov_obj @fooormore |
126 | $ov_obj %keyandmore TODO |
127 | ! $ov_obj %fooormore |
128 | $ov_obj /key/ |
129 | ! $ov_obj /foo/ |
130 | $ov_obj qr/Key/i |
131 | ! $ov_obj qr/foo/ |
18d11902 |
132 | $ov_obj sub { shift ~~ "key" } |
73aec0b1 |
133 | ! $ov_obj sub { shift eq "key" } |
18d11902 |
134 | ! $ov_obj sub { shift ~~ "foo" } |
1cfb7049 |
135 | ! $ov_obj \&foo |
4cbab0e9 |
136 | $ov_obj \&bar |
1cfb7049 |
137 | @ $ov_obj \&fatal |
18d11902 |
138 | ! $ov_obj FALSE |
139 | ! $ov_obj \&FALSE |
33570f8b |
140 | ! $ov_obj undef |
4cbab0e9 |
141 | $ov_obj $ov_obj |
1cfb7049 |
142 | |
143 | # regular object |
144 | @ $obj "key" |
145 | @ $obj {"key" => 1} |
4cbab0e9 |
146 | @ $obj ["key" => 1] |
73aec0b1 |
147 | @ $obj /key/ |
148 | @ $obj qr/key/ |
1cfb7049 |
149 | @ $obj sub { 1 } |
150 | @ $obj sub { 0 } |
151 | @ $obj \&foo |
152 | @ $obj \&fatal |
18d11902 |
153 | @ $obj FALSE |
154 | @ $obj \&FALSE |
33570f8b |
155 | ! $obj undef |
4cbab0e9 |
156 | @ $obj $obj |
1cfb7049 |
157 | |
0d863452 |
158 | # CODE ref against argument |
159 | # - arg is code ref |
160 | \&foo \&foo |
161 | ! \&foo sub {} |
18d11902 |
162 | ! \&foo sub { "$_[0]" =~ /^CODE/ } |
0d863452 |
163 | ! \&foo \&bar |
1cfb7049 |
164 | \&fatal \&fatal |
165 | ! \&foo \&fatal |
0d863452 |
166 | |
167 | # - arg is not code ref |
1cfb7049 |
168 | 1 sub{shift} |
169 | ! 0 sub{shift} |
170 | ! undef sub{shift} |
171 | undef sub{not shift} |
18d11902 |
172 | FALSE sub{not shift} |
1cfb7049 |
173 | 1 sub{scalar @_} |
174 | [] \&bar |
175 | {} \&bar |
176 | qr// \&bar |
177 | ! [] \&foo |
178 | ! {} \&foo |
179 | ! qr// \&foo |
180 | ! undef \&foo |
181 | undef \&bar |
182 | @ undef \&fatal |
183 | @ 1 \&fatal |
184 | @ [] \&fatal |
185 | @ "foo" \&fatal |
186 | @ qr// \&fatal |
73aec0b1 |
187 | # pass argument by reference |
188 | @fooormore sub{scalar @_ == 1} |
189 | @fooormore sub{"@_" =~ /ARRAY/} |
190 | %fooormore sub{"@_" =~ /HASH/} |
191 | /fooormore/ sub{ref $_[0] eq 'Regexp'} |
0d863452 |
192 | |
193 | # - null-prototyped subs |
194 | a_const "a constant" |
195 | a_const a_const |
196 | a_const b_const |
1cfb7049 |
197 | \&a_const \&a_const |
198 | ! \&a_const \&b_const |
18d11902 |
199 | ! undef \&FALSE |
200 | undef \&TRUE |
201 | ! 0 \&FALSE |
202 | 0 \&TRUE |
203 | ! 1 \&FALSE |
204 | 1 \&TRUE |
205 | \&FALSE \&FALSE |
206 | ! \&FALSE \&foo |
207 | ! \&FALSE \&bar |
208 | ! \&TRUE \&foo |
209 | ! \&TRUE \&bar |
210 | ! \&TWO \&foo |
211 | ! \&TWO \&bar |
212 | \&FALSE \&FALSE |
1cfb7049 |
213 | |
214 | # - non-null-prototyped subs |
215 | ! \&bar \&gorch |
216 | bar gorch |
217 | @ fatal bar |
0d863452 |
218 | |
219 | # HASH ref against: |
220 | # - another hash ref |
221 | {} {} |
222 | ! {} {1 => 2} |
223 | {1 => 2} {1 => 2} |
224 | {1 => 2} {1 => 3} |
225 | ! {1 => 2} {2 => 3} |
226 | \%main:: {map {$_ => 'x'} keys %main::} |
227 | |
228 | # - tied hash ref |
229 | \%hash \%tied_hash |
230 | \%tied_hash \%tied_hash |
231 | |
232 | # - an array ref |
233 | \%:: [keys %main::] |
234 | ! \%:: [] |
235 | {"" => 1} [undef] |
71b0fb34 |
236 | { foo => 1 } ["foo"] |
237 | { foo => 1 } ["foo", "bar"] |
238 | \%hash ["foo", "bar"] |
239 | \%hash ["foo"] |
240 | ! \%hash ["quux"] |
241 | \%hash [qw(foo quux)] |
0d863452 |
242 | |
243 | # - a regex |
244 | {foo => 1} qr/^(fo[ox])$/ |
fceebc47 |
245 | ! +{0..99} qr/[13579]$/ |
0d863452 |
246 | |
247 | # - a string |
248 | +{foo => 1, bar => 2} "foo" |
249 | ! +{foo => 1, bar => 2} "baz" |
250 | |
251 | |
252 | # ARRAY ref against: |
253 | # - another array ref |
1cfb7049 |
254 | [] [] |
255 | ! [] [1] |
0d863452 |
256 | [["foo"], ["bar"]] [qr/o/, qr/a/] |
257 | ["foo", "bar"] [qr/o/, qr/a/] |
71b0fb34 |
258 | ! ["foo", "bar"] [qr/o/, "foo"] |
1cfb7049 |
259 | $deep1 $deep1 |
260 | ! $deep1 $deep2 |
0d863452 |
261 | |
1cfb7049 |
262 | \@nums \@tied_nums |
0d863452 |
263 | |
264 | # - a regex |
265 | [qw(foo bar baz quux)] qr/x/ |
266 | ! [qw(foo bar baz quux)] qr/y/ |
267 | |
268 | # - a number |
269 | [qw(1foo 2bar)] 2 |
25a0c96d |
270 | [qw(foo 2)] 2 |
271 | [qw(foo 2)] 2.0_0e+0 |
272 | ! [qw(1foo bar2)] 2 |
0d863452 |
273 | |
274 | # - a string |
275 | ! [qw(1foo 2bar)] "2" |
25a0c96d |
276 | [qw(1foo 2bar)] "2bar" |
0d863452 |
277 | |
278 | # Number against number |
279 | 2 2 |
280 | ! 2 3 |
18d11902 |
281 | 0 FALSE |
282 | 3-2 TRUE |
0d863452 |
283 | |
284 | # Number against string |
285 | 2 "2" |
286 | 2 "2.0" |
287 | ! 2 "2bananas" |
288 | ! 2_3 "2_3" |
18d11902 |
289 | FALSE "0" |
0d863452 |
290 | |
291 | # Regex against string |
292 | qr/x/ "x" |
293 | ! qr/y/ "x" |
294 | |
295 | # Regex against number |
296 | 12345 qr/3/ |
297 | |
298 | |
299 | # Test the implicit referencing |
300 | @nums 7 |
301 | @nums \@nums |
302 | ! @nums \\@nums |
303 | @nums [1..10] |
304 | ! @nums [0..9] |
305 | |
306 | %hash "foo" |
307 | %hash /bar/ |
71b0fb34 |
308 | %hash [qw(bar)] |
309 | ! %hash [qw(a b c)] |
310 | %hash %hash |
fceebc47 |
311 | %hash +{%hash} |
73aec0b1 |
312 | %hash \%hash |
71b0fb34 |
313 | %hash %tied_hash |
314 | %tied_hash %tied_hash |
315 | %hash { foo => 5, bar => 10 } |
316 | ! %hash { foo => 5, bar => 10, quux => 15 } |
317 | |
318 | @nums { 1, '', 2, '' } |
319 | @nums { 1, '', 12, '' } |
320 | ! @nums { 11, '', 12, '' } |
b472f62a |
321 | |
322 | # UNDEF |
323 | ! 3 undef |
324 | ! 1 undef |
325 | ! [] undef |
326 | ! {} undef |
327 | ! \%::main undef |
328 | ! [1,2] undef |
329 | ! %hash undef |
330 | ! @nums undef |
331 | ! "foo" undef |
332 | ! "" undef |
333 | ! !1 undef |
334 | ! \&foo undef |
335 | ! sub { } undef |
161d9976 |
336 | undef undef |
337 | $::undef undef |