t/comp/proto.t

   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;