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. |
10 | |
11 | use strict; |
12 | |
13 | print "1..74\n"; |
14 | |
15 | my $i = 1; |
16 | |
17 | sub testing (&$) { |
18 | my $p = prototype(shift); |
19 | my $c = shift; |
20 | my $what = defined $c ? '(' . $p . ')' : 'no prototype'; |
21 | print '#' x 25,"\n"; |
22 | print '# Testing ',$what,"\n"; |
23 | print '#' x 25,"\n"; |
24 | print "not " |
25 | if((defined($p) && defined($c) && $p ne $c) |
26 | || (defined($p) != defined($c))); |
27 | printf "ok %d\n",$i++; |
28 | } |
29 | |
30 | @_ = qw(a b c d); |
31 | my @array; |
32 | my %hash; |
33 | |
34 | ## |
35 | ## |
36 | ## |
37 | |
38 | testing \&no_proto, undef; |
39 | |
40 | sub no_proto { |
41 | print "# \@_ = (",join(",",@_),")\n"; |
42 | scalar(@_) |
43 | } |
44 | |
45 | print "not " unless 0 == no_proto(); |
46 | printf "ok %d\n",$i++; |
47 | |
48 | print "not " unless 1 == no_proto(5); |
49 | printf "ok %d\n",$i++; |
50 | |
51 | print "not " unless 4 == &no_proto; |
52 | printf "ok %d\n",$i++; |
53 | |
54 | print "not " unless 1 == no_proto +6; |
55 | printf "ok %d\n",$i++; |
56 | |
57 | print "not " unless 4 == no_proto(@_); |
58 | printf "ok %d\n",$i++; |
59 | |
60 | ## |
61 | ## |
62 | ## |
63 | |
64 | |
65 | testing \&no_args, ''; |
66 | |
67 | sub no_args () { |
68 | print "# \@_ = (",join(",",@_),")\n"; |
69 | scalar(@_) |
70 | } |
71 | |
72 | print "not " unless 0 == no_args(); |
73 | printf "ok %d\n",$i++; |
74 | |
75 | print "not " unless 0 == no_args; |
76 | printf "ok %d\n",$i++; |
77 | |
78 | print "not " unless 5 == no_args +5; |
79 | printf "ok %d\n",$i++; |
80 | |
81 | print "not " unless 4 == &no_args; |
82 | printf "ok %d\n",$i++; |
83 | |
84 | print "not " unless 2 == &no_args(1,2); |
85 | printf "ok %d\n",$i++; |
86 | |
87 | eval "no_args(1)"; |
88 | print "not " unless $@; |
89 | printf "ok %d\n",$i++; |
90 | |
91 | ## |
92 | ## |
93 | ## |
94 | |
95 | testing \&one_args, '$'; |
96 | |
97 | sub one_args ($) { |
98 | print "# \@_ = (",join(",",@_),")\n"; |
99 | scalar(@_) |
100 | } |
101 | |
102 | print "not " unless 1 == one_args(1); |
103 | printf "ok %d\n",$i++; |
104 | |
105 | print "not " unless 1 == one_args +5; |
106 | printf "ok %d\n",$i++; |
107 | |
108 | print "not " unless 4 == &one_args; |
109 | printf "ok %d\n",$i++; |
110 | |
111 | print "not " unless 2 == &one_args(1,2); |
112 | printf "ok %d\n",$i++; |
113 | |
114 | eval "one_args(1,2)"; |
115 | print "not " unless $@; |
116 | printf "ok %d\n",$i++; |
117 | |
118 | eval "one_args()"; |
119 | print "not " unless $@; |
120 | printf "ok %d\n",$i++; |
121 | |
122 | sub one_a_args ($) { |
123 | print "# \@_ = (",join(",",@_),")\n"; |
124 | print "not " unless @_ == 1 && $_[0] == 4; |
125 | printf "ok %d\n",$i++; |
126 | } |
127 | |
128 | one_a_args(@_); |
129 | |
130 | ## |
131 | ## |
132 | ## |
133 | |
134 | testing \&over_one_args, '$@'; |
135 | |
136 | sub over_one_args ($@) { |
137 | print "# \@_ = (",join(",",@_),")\n"; |
138 | scalar(@_) |
139 | } |
140 | |
141 | print "not " unless 1 == over_one_args(1); |
142 | printf "ok %d\n",$i++; |
143 | |
144 | print "not " unless 2 == over_one_args(1,2); |
145 | printf "ok %d\n",$i++; |
146 | |
147 | print "not " unless 1 == over_one_args +5; |
148 | printf "ok %d\n",$i++; |
149 | |
150 | print "not " unless 4 == &over_one_args; |
151 | printf "ok %d\n",$i++; |
152 | |
153 | print "not " unless 2 == &over_one_args(1,2); |
154 | printf "ok %d\n",$i++; |
155 | |
156 | print "not " unless 5 == &over_one_args(1,@_); |
157 | printf "ok %d\n",$i++; |
158 | |
159 | eval "over_one_args()"; |
160 | print "not " unless $@; |
161 | printf "ok %d\n",$i++; |
162 | |
163 | sub over_one_a_args ($@) { |
164 | print "# \@_ = (",join(",",@_),")\n"; |
165 | print "not " unless @_ >= 1 && $_[0] == 4; |
166 | printf "ok %d\n",$i++; |
167 | } |
168 | |
169 | over_one_a_args(@_); |
170 | over_one_a_args(@_,1); |
171 | over_one_a_args(@_,1,2); |
172 | over_one_a_args(@_,@_); |
173 | |
174 | ## |
175 | ## |
176 | ## |
177 | |
178 | testing \&scalar_and_hash, '$%'; |
179 | |
180 | sub scalar_and_hash ($%) { |
181 | print "# \@_ = (",join(",",@_),")\n"; |
182 | scalar(@_) |
183 | } |
184 | |
185 | print "not " unless 1 == scalar_and_hash(1); |
186 | printf "ok %d\n",$i++; |
187 | |
188 | print "not " unless 3 == scalar_and_hash(1,2,3); |
189 | printf "ok %d\n",$i++; |
190 | |
191 | print "not " unless 1 == scalar_and_hash +5; |
192 | printf "ok %d\n",$i++; |
193 | |
194 | print "not " unless 4 == &scalar_and_hash; |
195 | printf "ok %d\n",$i++; |
196 | |
197 | print "not " unless 2 == &scalar_and_hash(1,2); |
198 | printf "ok %d\n",$i++; |
199 | |
200 | print "not " unless 5 == &scalar_and_hash(1,@_); |
201 | printf "ok %d\n",$i++; |
202 | |
203 | eval "scalar_and_hash()"; |
204 | print "not " unless $@; |
205 | printf "ok %d\n",$i++; |
206 | |
207 | sub scalar_and_hash_a ($@) { |
208 | print "# \@_ = (",join(",",@_),")\n"; |
209 | print "not " unless @_ >= 1 && $_[0] == 4; |
210 | printf "ok %d\n",$i++; |
211 | } |
212 | |
213 | scalar_and_hash_a(@_); |
214 | scalar_and_hash_a(@_,1); |
215 | scalar_and_hash_a(@_,1,2); |
216 | scalar_and_hash_a(@_,@_); |
217 | |
218 | ## |
219 | ## |
220 | ## |
221 | |
222 | testing \&one_or_two, '$;$'; |
223 | |
224 | sub one_or_two ($;$) { |
225 | print "# \@_ = (",join(",",@_),")\n"; |
226 | scalar(@_) |
227 | } |
228 | |
229 | print "not " unless 1 == one_or_two(1); |
230 | printf "ok %d\n",$i++; |
231 | |
232 | print "not " unless 2 == one_or_two(1,3); |
233 | printf "ok %d\n",$i++; |
234 | |
235 | print "not " unless 1 == one_or_two +5; |
236 | printf "ok %d\n",$i++; |
237 | |
238 | print "not " unless 4 == &one_or_two; |
239 | printf "ok %d\n",$i++; |
240 | |
241 | print "not " unless 3 == &one_or_two(1,2,3); |
242 | printf "ok %d\n",$i++; |
243 | |
244 | print "not " unless 5 == &one_or_two(1,@_); |
245 | printf "ok %d\n",$i++; |
246 | |
247 | eval "one_or_two()"; |
248 | print "not " unless $@; |
249 | printf "ok %d\n",$i++; |
250 | |
251 | eval "one_or_two(1,2,3)"; |
252 | print "not " unless $@; |
253 | printf "ok %d\n",$i++; |
254 | |
255 | sub one_or_two_a ($;$) { |
256 | print "# \@_ = (",join(",",@_),")\n"; |
257 | print "not " unless @_ >= 1 && $_[0] == 4; |
258 | printf "ok %d\n",$i++; |
259 | } |
260 | |
261 | one_or_two_a(@_); |
262 | one_or_two_a(@_,1); |
263 | one_or_two_a(@_,@_); |
264 | |
265 | ## |
266 | ## |
267 | ## |
268 | |
269 | testing \&a_sub, '&'; |
270 | |
271 | sub a_sub (&) { |
272 | print "# \@_ = (",join(",",@_),")\n"; |
273 | &{$_[0]}; |
274 | } |
275 | |
276 | sub tmp_sub_1 { printf "ok %d\n",$i++ } |
277 | |
278 | a_sub { printf "ok %d\n",$i++ }; |
279 | a_sub \&tmp_sub_1; |
280 | |
281 | @array = ( \&tmp_sub_1 ); |
282 | eval 'a_sub @array'; |
283 | print "not " unless $@; |
284 | printf "ok %d\n",$i++; |
285 | |
286 | ## |
287 | ## |
288 | ## |
289 | |
290 | testing \&sub_aref, '&\@'; |
291 | |
292 | sub sub_aref (&\@) { |
293 | print "# \@_ = (",join(",",@_),")\n"; |
294 | my($sub,$array) = @_; |
295 | print "not " unless @_ == 2 && @{$array} == 4; |
296 | print map { &{$sub}($_) } @{$array} |
297 | } |
298 | |
299 | @array = (qw(O K)," ", $i++); |
300 | sub_aref { lc shift } @array; |
301 | print "\n"; |
302 | |
303 | ## |
304 | ## |
305 | ## |
306 | |
307 | testing \&sub_array, '&@'; |
308 | |
309 | sub sub_array (&@) { |
310 | print "# \@_ = (",join(",",@_),")\n"; |
311 | print "not " unless @_ == 5; |
312 | my $sub = shift; |
313 | print map { &{$sub}($_) } @_ |
314 | } |
315 | |
316 | @array = (qw(O K)," ", $i++); |
317 | sub_array { lc shift } @array; |
318 | print "\n"; |
319 | |
320 | ## |
321 | ## |
322 | ## |
323 | |
324 | testing \&a_hash, '%'; |
325 | |
326 | sub a_hash (%) { |
327 | print "# \@_ = (",join(",",@_),")\n"; |
328 | scalar(@_); |
329 | } |
330 | |
331 | print "not " unless 1 == a_hash 'a'; |
332 | printf "ok %d\n",$i++; |
333 | |
334 | print "not " unless 2 == a_hash 'a','b'; |
335 | printf "ok %d\n",$i++; |
336 | |
337 | ## |
338 | ## |
339 | ## |
340 | |
341 | testing \&a_hash_ref, '\%'; |
342 | |
343 | sub a_hash_ref (\%) { |
344 | print "# \@_ = (",join(",",@_),")\n"; |
345 | print "not " unless ref($_[0]) && $_[0]->{'a'}; |
346 | printf "ok %d\n",$i++; |
347 | $_[0]->{'b'} = 2; |
348 | } |
349 | |
350 | %hash = ( a => 1); |
351 | a_hash_ref %hash; |
352 | print "not " unless $hash{'b'} == 2; |
353 | printf "ok %d\n",$i++; |
354 | |
355 | ## |
356 | ## |
357 | ## |
358 | |
359 | testing \&an_array_ref, '\@'; |
360 | |
361 | sub an_array_ref (\@) { |
362 | print "# \@_ = (",join(",",@_),")\n"; |
363 | print "not " unless ref($_[0]) && 1 == @{$_[0]}; |
364 | printf "ok %d\n",$i++; |
365 | @{$_[0]} = (qw(ok)," ",$i++,"\n"); |
366 | } |
367 | |
368 | @array = ('a'); |
369 | an_array_ref @array; |
370 | print "not " unless @array == 4; |
371 | print @array; |