Commit | Line | Data |
28757baa |
1 | #!./perl |
2 | # |
3 | # Contributed by Graham Barr <Graham.Barr@tiuk.ti.com> |
4 | # |
5 | # So far there are tests for the following prototypes. |
6 | # none, () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@) |
7 | # |
8 | # It is impossible to test every prototype that can be specified, but |
9 | # we should test as many as we can. |
44a8e56a |
10 | # |
11 | |
12 | BEGIN { |
13 | chdir 't' if -d 't'; |
14 | @INC = '../lib'; |
15 | } |
28757baa |
16 | |
17 | use strict; |
18 | |
57ff9a15 |
19 | print "1..82\n"; |
28757baa |
20 | |
21 | my $i = 1; |
22 | |
23 | sub testing (&$) { |
24 | my $p = prototype(shift); |
25 | my $c = shift; |
26 | my $what = defined $c ? '(' . $p . ')' : 'no prototype'; |
27 | print '#' x 25,"\n"; |
28 | print '# Testing ',$what,"\n"; |
29 | print '#' x 25,"\n"; |
30 | print "not " |
31 | if((defined($p) && defined($c) && $p ne $c) |
32 | || (defined($p) != defined($c))); |
33 | printf "ok %d\n",$i++; |
34 | } |
35 | |
36 | @_ = qw(a b c d); |
37 | my @array; |
38 | my %hash; |
39 | |
40 | ## |
41 | ## |
42 | ## |
43 | |
44 | testing \&no_proto, undef; |
45 | |
46 | sub no_proto { |
47 | print "# \@_ = (",join(",",@_),")\n"; |
48 | scalar(@_) |
49 | } |
50 | |
51 | print "not " unless 0 == no_proto(); |
52 | printf "ok %d\n",$i++; |
53 | |
54 | print "not " unless 1 == no_proto(5); |
55 | printf "ok %d\n",$i++; |
56 | |
57 | print "not " unless 4 == &no_proto; |
58 | printf "ok %d\n",$i++; |
59 | |
60 | print "not " unless 1 == no_proto +6; |
61 | printf "ok %d\n",$i++; |
62 | |
63 | print "not " unless 4 == no_proto(@_); |
64 | printf "ok %d\n",$i++; |
65 | |
66 | ## |
67 | ## |
68 | ## |
69 | |
70 | |
71 | testing \&no_args, ''; |
72 | |
73 | sub no_args () { |
74 | print "# \@_ = (",join(",",@_),")\n"; |
75 | scalar(@_) |
76 | } |
77 | |
78 | print "not " unless 0 == no_args(); |
79 | printf "ok %d\n",$i++; |
80 | |
81 | print "not " unless 0 == no_args; |
82 | printf "ok %d\n",$i++; |
83 | |
84 | print "not " unless 5 == no_args +5; |
85 | printf "ok %d\n",$i++; |
86 | |
87 | print "not " unless 4 == &no_args; |
88 | printf "ok %d\n",$i++; |
89 | |
90 | print "not " unless 2 == &no_args(1,2); |
91 | printf "ok %d\n",$i++; |
92 | |
93 | eval "no_args(1)"; |
94 | print "not " unless $@; |
95 | printf "ok %d\n",$i++; |
96 | |
97 | ## |
98 | ## |
99 | ## |
100 | |
101 | testing \&one_args, '$'; |
102 | |
103 | sub one_args ($) { |
104 | print "# \@_ = (",join(",",@_),")\n"; |
105 | scalar(@_) |
106 | } |
107 | |
108 | print "not " unless 1 == one_args(1); |
109 | printf "ok %d\n",$i++; |
110 | |
111 | print "not " unless 1 == one_args +5; |
112 | printf "ok %d\n",$i++; |
113 | |
114 | print "not " unless 4 == &one_args; |
115 | printf "ok %d\n",$i++; |
116 | |
117 | print "not " unless 2 == &one_args(1,2); |
118 | printf "ok %d\n",$i++; |
119 | |
120 | eval "one_args(1,2)"; |
121 | print "not " unless $@; |
122 | printf "ok %d\n",$i++; |
123 | |
124 | eval "one_args()"; |
125 | print "not " unless $@; |
126 | printf "ok %d\n",$i++; |
127 | |
128 | sub one_a_args ($) { |
129 | print "# \@_ = (",join(",",@_),")\n"; |
130 | print "not " unless @_ == 1 && $_[0] == 4; |
131 | printf "ok %d\n",$i++; |
132 | } |
133 | |
134 | one_a_args(@_); |
135 | |
136 | ## |
137 | ## |
138 | ## |
139 | |
140 | testing \&over_one_args, '$@'; |
141 | |
142 | sub over_one_args ($@) { |
143 | print "# \@_ = (",join(",",@_),")\n"; |
144 | scalar(@_) |
145 | } |
146 | |
147 | print "not " unless 1 == over_one_args(1); |
148 | printf "ok %d\n",$i++; |
149 | |
150 | print "not " unless 2 == over_one_args(1,2); |
151 | printf "ok %d\n",$i++; |
152 | |
153 | print "not " unless 1 == over_one_args +5; |
154 | printf "ok %d\n",$i++; |
155 | |
156 | print "not " unless 4 == &over_one_args; |
157 | printf "ok %d\n",$i++; |
158 | |
159 | print "not " unless 2 == &over_one_args(1,2); |
160 | printf "ok %d\n",$i++; |
161 | |
162 | print "not " unless 5 == &over_one_args(1,@_); |
163 | printf "ok %d\n",$i++; |
164 | |
165 | eval "over_one_args()"; |
166 | print "not " unless $@; |
167 | printf "ok %d\n",$i++; |
168 | |
169 | sub over_one_a_args ($@) { |
170 | print "# \@_ = (",join(",",@_),")\n"; |
171 | print "not " unless @_ >= 1 && $_[0] == 4; |
172 | printf "ok %d\n",$i++; |
173 | } |
174 | |
175 | over_one_a_args(@_); |
176 | over_one_a_args(@_,1); |
177 | over_one_a_args(@_,1,2); |
178 | over_one_a_args(@_,@_); |
179 | |
180 | ## |
181 | ## |
182 | ## |
183 | |
184 | testing \&scalar_and_hash, '$%'; |
185 | |
186 | sub scalar_and_hash ($%) { |
187 | print "# \@_ = (",join(",",@_),")\n"; |
188 | scalar(@_) |
189 | } |
190 | |
191 | print "not " unless 1 == scalar_and_hash(1); |
192 | printf "ok %d\n",$i++; |
193 | |
194 | print "not " unless 3 == scalar_and_hash(1,2,3); |
195 | printf "ok %d\n",$i++; |
196 | |
197 | print "not " unless 1 == scalar_and_hash +5; |
198 | printf "ok %d\n",$i++; |
199 | |
200 | print "not " unless 4 == &scalar_and_hash; |
201 | printf "ok %d\n",$i++; |
202 | |
203 | print "not " unless 2 == &scalar_and_hash(1,2); |
204 | printf "ok %d\n",$i++; |
205 | |
206 | print "not " unless 5 == &scalar_and_hash(1,@_); |
207 | printf "ok %d\n",$i++; |
208 | |
209 | eval "scalar_and_hash()"; |
210 | print "not " unless $@; |
211 | printf "ok %d\n",$i++; |
212 | |
213 | sub scalar_and_hash_a ($@) { |
214 | print "# \@_ = (",join(",",@_),")\n"; |
215 | print "not " unless @_ >= 1 && $_[0] == 4; |
216 | printf "ok %d\n",$i++; |
217 | } |
218 | |
219 | scalar_and_hash_a(@_); |
220 | scalar_and_hash_a(@_,1); |
221 | scalar_and_hash_a(@_,1,2); |
222 | scalar_and_hash_a(@_,@_); |
223 | |
224 | ## |
225 | ## |
226 | ## |
227 | |
228 | testing \&one_or_two, '$;$'; |
229 | |
230 | sub one_or_two ($;$) { |
231 | print "# \@_ = (",join(",",@_),")\n"; |
232 | scalar(@_) |
233 | } |
234 | |
235 | print "not " unless 1 == one_or_two(1); |
236 | printf "ok %d\n",$i++; |
237 | |
238 | print "not " unless 2 == one_or_two(1,3); |
239 | printf "ok %d\n",$i++; |
240 | |
241 | print "not " unless 1 == one_or_two +5; |
242 | printf "ok %d\n",$i++; |
243 | |
244 | print "not " unless 4 == &one_or_two; |
245 | printf "ok %d\n",$i++; |
246 | |
247 | print "not " unless 3 == &one_or_two(1,2,3); |
248 | printf "ok %d\n",$i++; |
249 | |
250 | print "not " unless 5 == &one_or_two(1,@_); |
251 | printf "ok %d\n",$i++; |
252 | |
253 | eval "one_or_two()"; |
254 | print "not " unless $@; |
255 | printf "ok %d\n",$i++; |
256 | |
257 | eval "one_or_two(1,2,3)"; |
258 | print "not " unless $@; |
259 | printf "ok %d\n",$i++; |
260 | |
261 | sub one_or_two_a ($;$) { |
262 | print "# \@_ = (",join(",",@_),")\n"; |
263 | print "not " unless @_ >= 1 && $_[0] == 4; |
264 | printf "ok %d\n",$i++; |
265 | } |
266 | |
267 | one_or_two_a(@_); |
268 | one_or_two_a(@_,1); |
269 | one_or_two_a(@_,@_); |
270 | |
271 | ## |
272 | ## |
273 | ## |
274 | |
275 | testing \&a_sub, '&'; |
276 | |
277 | sub a_sub (&) { |
278 | print "# \@_ = (",join(",",@_),")\n"; |
279 | &{$_[0]}; |
280 | } |
281 | |
282 | sub tmp_sub_1 { printf "ok %d\n",$i++ } |
283 | |
284 | a_sub { printf "ok %d\n",$i++ }; |
285 | a_sub \&tmp_sub_1; |
286 | |
287 | @array = ( \&tmp_sub_1 ); |
288 | eval 'a_sub @array'; |
289 | print "not " unless $@; |
290 | printf "ok %d\n",$i++; |
291 | |
292 | ## |
293 | ## |
294 | ## |
295 | |
296 | testing \&sub_aref, '&\@'; |
297 | |
298 | sub sub_aref (&\@) { |
299 | print "# \@_ = (",join(",",@_),")\n"; |
300 | my($sub,$array) = @_; |
301 | print "not " unless @_ == 2 && @{$array} == 4; |
302 | print map { &{$sub}($_) } @{$array} |
303 | } |
304 | |
305 | @array = (qw(O K)," ", $i++); |
306 | sub_aref { lc shift } @array; |
307 | print "\n"; |
308 | |
309 | ## |
310 | ## |
311 | ## |
312 | |
313 | testing \&sub_array, '&@'; |
314 | |
315 | sub sub_array (&@) { |
316 | print "# \@_ = (",join(",",@_),")\n"; |
317 | print "not " unless @_ == 5; |
318 | my $sub = shift; |
319 | print map { &{$sub}($_) } @_ |
320 | } |
321 | |
322 | @array = (qw(O K)," ", $i++); |
323 | sub_array { lc shift } @array; |
324 | print "\n"; |
325 | |
326 | ## |
327 | ## |
328 | ## |
329 | |
330 | testing \&a_hash, '%'; |
331 | |
332 | sub a_hash (%) { |
333 | print "# \@_ = (",join(",",@_),")\n"; |
334 | scalar(@_); |
335 | } |
336 | |
337 | print "not " unless 1 == a_hash 'a'; |
338 | printf "ok %d\n",$i++; |
339 | |
340 | print "not " unless 2 == a_hash 'a','b'; |
341 | printf "ok %d\n",$i++; |
342 | |
343 | ## |
344 | ## |
345 | ## |
346 | |
347 | testing \&a_hash_ref, '\%'; |
348 | |
349 | sub a_hash_ref (\%) { |
350 | print "# \@_ = (",join(",",@_),")\n"; |
351 | print "not " unless ref($_[0]) && $_[0]->{'a'}; |
352 | printf "ok %d\n",$i++; |
353 | $_[0]->{'b'} = 2; |
354 | } |
355 | |
356 | %hash = ( a => 1); |
357 | a_hash_ref %hash; |
358 | print "not " unless $hash{'b'} == 2; |
359 | printf "ok %d\n",$i++; |
360 | |
361 | ## |
362 | ## |
363 | ## |
364 | |
69dcf70c |
365 | testing \&array_ref_plus, '\@@'; |
28757baa |
366 | |
69dcf70c |
367 | sub array_ref_plus (\@@) { |
28757baa |
368 | print "# \@_ = (",join(",",@_),")\n"; |
69dcf70c |
369 | print "not " unless @_ == 2 && ref($_[0]) && 1 == @{$_[0]} && $_[1] eq 'x'; |
28757baa |
370 | printf "ok %d\n",$i++; |
371 | @{$_[0]} = (qw(ok)," ",$i++,"\n"); |
372 | } |
373 | |
374 | @array = ('a'); |
69dcf70c |
375 | { my @more = ('x'); |
376 | array_ref_plus @array, @more; } |
28757baa |
377 | print "not " unless @array == 4; |
378 | print @array; |
fb73857a |
379 | |
b6c543e3 |
380 | my $p; |
381 | print "not " if defined prototype('CORE::print'); |
382 | print "ok ", $i++, "\n"; |
383 | |
384 | print "not " if defined prototype('CORE::system'); |
385 | print "ok ", $i++, "\n"; |
386 | |
387 | print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$'; |
388 | print "ok ", $i++, "\n"; |
389 | |
390 | print "# CORE:Foo => ($p), \$@ => `$@'\nnot " |
391 | if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Cannot find an opnumber/; |
392 | print "ok ", $i++, "\n"; |
393 | |
fb73857a |
394 | # correctly note too-short parameter lists that don't end with '$', |
395 | # a possible regression. |
396 | |
397 | sub foo1 ($\@); |
398 | eval q{ foo1 "s" }; |
399 | print "not " unless $@ =~ /^Not enough/; |
400 | print "ok ", $i++, "\n"; |
401 | |
402 | sub foo2 ($\%); |
403 | eval q{ foo2 "s" }; |
404 | print "not " unless $@ =~ /^Not enough/; |
405 | print "ok ", $i++, "\n"; |
57ff9a15 |
406 | |
407 | sub X::foo3; |
408 | *X::foo3 = sub {'ok'}; |
409 | print "# $@not " unless eval {X->foo3} eq 'ok'; |
410 | print "ok ", $i++, "\n"; |
411 | |
412 | sub X::foo4 ($); |
413 | *X::foo4 = sub ($) {'ok'}; |
414 | print "not " unless X->foo4 eq 'ok'; |
415 | print "ok ", $i++, "\n"; |