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
  12 BEGIN {
  13     chdir 't' if -d 't';
  14     @INC = '../lib';
  15 }
  16
  17 # We need this, as in places we're testing the interaction of prototypes with
  18 # strict
  19 use strict;
  20
  21 print "1..160\n";
  22
  23 my $i = 1;
  24
  25 sub testing (&$) {
  26     my $p = prototype(shift);
  27     my $c = shift;
  28     my $what = defined $c ? '(' . $p . ')' : 'no prototype';
  29     print '#' x 25,"\n";
  30     print '# Testing ',$what,"\n";
  31     print '#' x 25,"\n";
  32     print "not "
  33         if((defined($p) && defined($c) && $p ne $c)
  34            || (defined($p) != defined($c)));
  35     printf "ok %d\n",$i++;
  36 }
  37
  38 @_ = qw(a b c d);
  39 my @array;
  40 my %hash;
  41
  42 ##
  43 ##
  44 ##
  45
  46 testing \&no_proto, undef;
  47
  48 sub no_proto {
  49     print "# \@_ = (",join(",",@_),")\n";
  50     scalar(@_)
  51 }
  52
  53 print "not " unless 0 == no_proto();
  54 printf "ok %d\n",$i++;
  55
  56 print "not " unless 1 == no_proto(5);
  57 printf "ok %d\n",$i++;
  58
  59 print "not " unless 4 == &no_proto;
  60 printf "ok %d\n",$i++;
  61
  62 print "not " unless 1 == no_proto +6;
  63 printf "ok %d\n",$i++;
  64
  65 print "not " unless 4 == no_proto(@_);
  66 printf "ok %d\n",$i++;
  67
  68 ##
  69 ##
  70 ##
  71
  72
  73 testing \&no_args, '';
  74
  75 sub no_args () {
  76     print "# \@_ = (",join(",",@_),")\n";
  77     scalar(@_)
  78 }
  79
  80 print "not " unless 0 == no_args();
  81 printf "ok %d\n",$i++;
  82
  83 print "not " unless 0 == no_args;
  84 printf "ok %d\n",$i++;
  85
  86 print "not " unless 5 == no_args +5;
  87 printf "ok %d\n",$i++;
  88
  89 print "not " unless 4 == &no_args;
  90 printf "ok %d\n",$i++;
  91
  92 print "not " unless 2 == &no_args(1,2);
  93 printf "ok %d\n",$i++;
  94
  95 eval "no_args(1)";
  96 print "not " unless $@;
  97 printf "ok %d\n",$i++;
  98
  99 ##
 100 ##
 101 ##
 102
 103 testing \&one_args, '$';
 104
 105 sub one_args ($) {
 106     print "# \@_ = (",join(",",@_),")\n";
 107     scalar(@_)
 108 }
 109
 110 print "not " unless 1 == one_args(1);
 111 printf "ok %d\n",$i++;
 112
 113 print "not " unless 1 == one_args +5;
 114 printf "ok %d\n",$i++;
 115
 116 print "not " unless 4 == &one_args;
 117 printf "ok %d\n",$i++;
 118
 119 print "not " unless 2 == &one_args(1,2);
 120 printf "ok %d\n",$i++;
 121
 122 eval "one_args(1,2)";
 123 print "not " unless $@;
 124 printf "ok %d\n",$i++;
 125
 126 eval "one_args()";
 127 print "not " unless $@;
 128 printf "ok %d\n",$i++;
 129
 130 sub one_a_args ($) {
 131     print "# \@_ = (",join(",",@_),")\n";
 132     print "not " unless @_ == 1 && $_[0] == 4;
 133     printf "ok %d\n",$i++;
 134 }
 135
 136 one_a_args(@_);
 137
 138 ##
 139 ##
 140 ##
 141
 142 testing \&over_one_args, '$@';
 143
 144 sub over_one_args ($@) {
 145     print "# \@_ = (",join(",",@_),")\n";
 146     scalar(@_)
 147 }
 148
 149 print "not " unless 1 == over_one_args(1);
 150 printf "ok %d\n",$i++;
 151
 152 print "not " unless 2 == over_one_args(1,2);
 153 printf "ok %d\n",$i++;
 154
 155 print "not " unless 1 == over_one_args +5;
 156 printf "ok %d\n",$i++;
 157
 158 print "not " unless 4 == &over_one_args;
 159 printf "ok %d\n",$i++;
 160
 161 print "not " unless 2 == &over_one_args(1,2);
 162 printf "ok %d\n",$i++;
 163
 164 print "not " unless 5 == &over_one_args(1,@_);
 165 printf "ok %d\n",$i++;
 166
 167 eval "over_one_args()";
 168 print "not " unless $@;
 169 printf "ok %d\n",$i++;
 170
 171 sub over_one_a_args ($@) {
 172     print "# \@_ = (",join(",",@_),")\n";
 173     print "not " unless @_ >= 1 && $_[0] == 4;
 174     printf "ok %d\n",$i++;
 175 }
 176
 177 over_one_a_args(@_);
 178 over_one_a_args(@_,1);
 179 over_one_a_args(@_,1,2);
 180 over_one_a_args(@_,@_);
 181
 182 ##
 183 ##
 184 ##
 185
 186 testing \&scalar_and_hash, '$%';
 187
 188 sub scalar_and_hash ($%) {
 189     print "# \@_ = (",join(",",@_),")\n";
 190     scalar(@_)
 191 }
 192
 193 print "not " unless 1 == scalar_and_hash(1);
 194 printf "ok %d\n",$i++;
 195
 196 print "not " unless 3 == scalar_and_hash(1,2,3);
 197 printf "ok %d\n",$i++;
 198
 199 print "not " unless 1 == scalar_and_hash +5;
 200 printf "ok %d\n",$i++;
 201
 202 print "not " unless 4 == &scalar_and_hash;
 203 printf "ok %d\n",$i++;
 204
 205 print "not " unless 2 == &scalar_and_hash(1,2);
 206 printf "ok %d\n",$i++;
 207
 208 print "not " unless 5 == &scalar_and_hash(1,@_);
 209 printf "ok %d\n",$i++;
 210
 211 eval "scalar_and_hash()";
 212 print "not " unless $@;
 213 printf "ok %d\n",$i++;
 214
 215 sub scalar_and_hash_a ($@) {
 216     print "# \@_ = (",join(",",@_),")\n";
 217     print "not " unless @_ >= 1 && $_[0] == 4;
 218     printf "ok %d\n",$i++;
 219 }
 220
 221 scalar_and_hash_a(@_);
 222 scalar_and_hash_a(@_,1);
 223 scalar_and_hash_a(@_,1,2);
 224 scalar_and_hash_a(@_,@_);
 225
 226 ##
 227 ##
 228 ##
 229
 230 testing \&one_or_two, '$;$';
 231
 232 sub one_or_two ($;$) {
 233     print "# \@_ = (",join(",",@_),")\n";
 234     scalar(@_)
 235 }
 236
 237 print "not " unless 1 == one_or_two(1);
 238 printf "ok %d\n",$i++;
 239
 240 print "not " unless 2 == one_or_two(1,3);
 241 printf "ok %d\n",$i++;
 242
 243 print "not " unless 1 == one_or_two +5;
 244 printf "ok %d\n",$i++;
 245
 246 print "not " unless 4 == &one_or_two;
 247 printf "ok %d\n",$i++;
 248
 249 print "not " unless 3 == &one_or_two(1,2,3);
 250 printf "ok %d\n",$i++;
 251
 252 print "not " unless 5 == &one_or_two(1,@_);
 253 printf "ok %d\n",$i++;
 254
 255 eval "one_or_two()";
 256 print "not " unless $@;
 257 printf "ok %d\n",$i++;
 258
 259 eval "one_or_two(1,2,3)";
 260 print "not " unless $@;
 261 printf "ok %d\n",$i++;
 262
 263 sub one_or_two_a ($;$) {
 264     print "# \@_ = (",join(",",@_),")\n";
 265     print "not " unless @_ >= 1 && $_[0] == 4;
 266     printf "ok %d\n",$i++;
 267 }
 268
 269 one_or_two_a(@_);
 270 one_or_two_a(@_,1);
 271 one_or_two_a(@_,@_);
 272
 273 ##
 274 ##
 275 ##
 276
 277 testing \&a_sub, '&';
 278
 279 sub a_sub (&) {
 280     print "# \@_ = (",join(",",@_),")\n";
 281     &{$_[0]};
 282 }
 283
 284 sub tmp_sub_1 { printf "ok %d\n",$i++ }
 285
 286 a_sub { printf "ok %d\n",$i++ };
 287 a_sub \&tmp_sub_1;
 288
 289 @array = ( \&tmp_sub_1 );
 290 eval 'a_sub @array';
 291 print "not " unless $@;
 292 printf "ok %d\n",$i++;
 293
 294 ##
 295 ##
 296 ##
 297
 298 testing \&a_subx, '\&';
 299
 300 sub a_subx (\&) {
 301     print "# \@_ = (",join(",",@_),")\n";
 302     &{$_[0]};
 303 }
 304
 305 sub tmp_sub_2 { printf "ok %d\n",$i++ }
 306 a_subx &tmp_sub_2;
 307
 308 @array = ( \&tmp_sub_2 );
 309 eval 'a_subx @array';
 310 print "not " unless $@;
 311 printf "ok %d\n",$i++;
 312
 313 ##
 314 ##
 315 ##
 316
 317 testing \&sub_aref, '&\@';
 318
 319 sub sub_aref (&\@) {
 320     print "# \@_ = (",join(",",@_),")\n";
 321     my($sub,$array) = @_;
 322     print "not " unless @_ == 2 && @{$array} == 4;
 323     print map { &{$sub}($_) } @{$array}
 324 }
 325
 326 @array = (qw(O K)," ", $i++);
 327 sub_aref { lc shift } @array;
 328 print "\n";
 329
 330 ##
 331 ##
 332 ##
 333
 334 testing \&sub_array, '&@';
 335
 336 sub sub_array (&@) {
 337     print "# \@_ = (",join(",",@_),")\n";
 338     print "not " unless @_ == 5;
 339     my $sub = shift;
 340     print map { &{$sub}($_) } @_
 341 }
 342
 343 @array = (qw(O K)," ", $i++);
 344 sub_array { lc shift } @array;
 345 sub_array { lc shift } ('O', 'K', ' ', $i++);
 346 print "\n";
 347
 348 ##
 349 ##
 350 ##
 351
 352 testing \&a_hash, '%';
 353
 354 sub a_hash (%) {
 355     print "# \@_ = (",join(",",@_),")\n";
 356     scalar(@_);
 357 }
 358
 359 print "not " unless 1 == a_hash 'a';
 360 printf "ok %d\n",$i++;
 361
 362 print "not " unless 2 == a_hash 'a','b';
 363 printf "ok %d\n",$i++;
 364
 365 ##
 366 ##
 367 ##
 368
 369 testing \&a_hash_ref, '\%';
 370
 371 sub a_hash_ref (\%) {
 372     print "# \@_ = (",join(",",@_),")\n";
 373     print "not " unless ref($_[0]) && $_[0]->{'a'};
 374     printf "ok %d\n",$i++;
 375     $_[0]->{'b'} = 2;
 376 }
 377
 378 %hash = ( a => 1);
 379 a_hash_ref %hash;
 380 print "not " unless $hash{'b'} == 2;
 381 printf "ok %d\n",$i++;
 382
 383 ##
 384 ##
 385 ##
 386
 387 testing \&array_ref_plus, '\@@';
 388
 389 sub array_ref_plus (\@@) {
 390     print "# \@_ = (",join(",",@_),")\n";
 391     print "not " unless @_ == 2 && ref($_[0]) && 1 == @{$_[0]} && $_[1] eq 'x';
 392     printf "ok %d\n",$i++;
 393     @{$_[0]} = (qw(ok)," ",$i++,"\n");
 394 }
 395
 396 @array = ('a');
 397 { my @more = ('x');
 398   array_ref_plus @array, @more; }
 399 print "not " unless @array == 4;
 400 print @array;
 401
 402 my $p;
 403 print "not " if defined prototype('CORE::print');
 404 print "ok ", $i++, "\n";
 405
 406 print "not " if defined prototype('CORE::system');
 407 print "ok ", $i++, "\n";
 408
 409 print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$@';
 410 print "ok ", $i++, "\n";
 411
 412 print "# CORE:Foo => ($p), \$@ => `$@'\nnot "
 413     if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Can't find an opnumber/;
 414 print "ok ", $i++, "\n";
 415
 416 # correctly note too-short parameter lists that don't end with '$',
 417 #  a possible regression.
 418
 419 sub foo1 ($\@);
 420 eval q{ foo1 "s" };
 421 print "not " unless $@ =~ /^Not enough/;
 422 print "ok ", $i++, "\n";
 423
 424 sub foo2 ($\%);
 425 eval q{ foo2 "s" };
 426 print "not " unless $@ =~ /^Not enough/;
 427 print "ok ", $i++, "\n";
 428
 429 sub X::foo3;
 430 *X::foo3 = sub {'ok'};
 431 print "# $@not " unless eval {X->foo3} eq 'ok';
 432 print "ok ", $i++, "\n";
 433
 434 sub X::foo4 ($);
 435 *X::foo4 = sub ($) {'ok'};
 436 print "not " unless X->foo4 eq 'ok';
 437 print "ok ", $i++, "\n";
 438
 439 # test if the (*) prototype allows barewords, constants, scalar expressions,
 440 # globs and globrefs (just as CORE::open() does), all under stricture
 441 sub star (*&) { &{$_[1]} }
 442 sub star2 (**&) { &{$_[2]} }
 443 sub BAR { "quux" }
 444 sub Bar::BAZ { "quuz" }
 445 my $star = 'FOO';
 446 star FOO, sub {
 447     print "not " unless $_[0] eq 'FOO';
 448     print "ok $i - star FOO\n";
 449 }; $i++;
 450 star(FOO, sub {
 451         print "not " unless $_[0] eq 'FOO';
 452         print "ok $i - star(FOO)\n";
 453     }); $i++;
 454 star "FOO", sub {
 455     print "not " unless $_[0] eq 'FOO';
 456     print qq/ok $i - star "FOO"\n/;
 457 }; $i++;
 458 star("FOO", sub {
 459         print "not " unless $_[0] eq 'FOO';
 460         print qq/ok $i - star("FOO")\n/;
 461     }); $i++;
 462 star $star, sub {
 463     print "not " unless $_[0] eq 'FOO';
 464     print "ok $i - star \$star\n";
 465 }; $i++;
 466 star($star, sub {
 467         print "not " unless $_[0] eq 'FOO';
 468         print "ok $i - star(\$star)\n";
 469     }); $i++;
 470 star *FOO, sub {
 471     print "not " unless $_[0] eq \*FOO;
 472     print "ok $i - star *FOO\n";
 473 }; $i++;
 474 star(*FOO, sub {
 475         print "not " unless $_[0] eq \*FOO;
 476         print "ok $i - star(*FOO)\n";
 477     }); $i++;
 478 star \*FOO, sub {
 479     print "not " unless $_[0] eq \*FOO;
 480     print "ok $i - star \\*FOO\n";
 481 }; $i++;
 482 star(\*FOO, sub {
 483         print "not " unless $_[0] eq \*FOO;
 484         print "ok $i - star(\\*FOO)\n";
 485     }); $i++;
 486 star2 FOO, BAR, sub {
 487     print "not " unless $_[0] eq 'FOO' and $_[1] eq 'BAR';
 488     print "ok $i - star2 FOO, BAR\n";
 489 }; $i++;
 490 star2(Bar::BAZ, FOO, sub {
 491         print "not " unless $_[0] eq 'Bar::BAZ' and $_[1] eq 'FOO';
 492         print "ok $i - star2(Bar::BAZ, FOO)\n"
 493     }); $i++;
 494 star2 BAR(), FOO, sub {
 495     print "not " unless $_[0] eq 'quux' and $_[1] eq 'FOO';
 496     print "ok $i - star2 BAR(), FOO\n"
 497 }; $i++;
 498 star2(FOO, BAR(), sub {
 499         print "not " unless $_[0] eq 'FOO' and $_[1] eq 'quux';
 500         print "ok $i - star2(FOO, BAR())\n";
 501     }); $i++;
 502 star2 "FOO", "BAR", sub {
 503     print "not " unless $_[0] eq 'FOO' and $_[1] eq 'BAR';
 504     print qq/ok $i - star2 "FOO", "BAR"\n/;
 505 }; $i++;
 506 star2("FOO", "BAR", sub {
 507         print "not " unless $_[0] eq 'FOO' and $_[1] eq 'BAR';
 508         print qq/ok $i - star2("FOO", "BAR")\n/;
 509     }); $i++;
 510 star2 $star, $star, sub {
 511     print "not " unless $_[0] eq 'FOO' and $_[1] eq 'FOO';
 512     print "ok $i - star2 \$star, \$star\n";
 513 }; $i++;
 514 star2($star, $star, sub {
 515         print "not " unless $_[0] eq 'FOO' and $_[1] eq 'FOO';
 516         print "ok $i - star2(\$star, \$star)\n";
 517     }); $i++;
 518 star2 *FOO, *BAR, sub {
 519     print "not " unless $_[0] eq \*FOO and $_[1] eq \*BAR;
 520     print "ok $i - star2 *FOO, *BAR\n";
 521 }; $i++;
 522 star2(*FOO, *BAR, sub {
 523         print "not " unless $_[0] eq \*FOO and $_[1] eq \*BAR;
 524         print "ok $i - star2(*FOO, *BAR)\n";
 525     }); $i++;
 526 star2 \*FOO, \*BAR, sub {
 527     no strict 'refs';
 528     print "not " unless $_[0] eq \*{'FOO'} and $_[1] eq \*{'BAR'};
 529     print "ok $i - star2 \*FOO, \*BAR\n";
 530 }; $i++;
 531 star2(\*FOO, \*BAR, sub {
 532         no strict 'refs';
 533         print "not " unless $_[0] eq \*{'FOO'} and $_[1] eq \*{'BAR'};
 534         print "ok $i - star2(\*FOO, \*BAR)\n";
 535     }); $i++;
 536
 537 # test scalarref prototype
 538 sub sreftest (\$$) {
 539     print "not " unless ref $_[0];
 540     print "ok $_[1] - sreftest\n";
 541 }
 542 {
 543     no strict 'vars';
 544     sreftest my $sref, $i++;
 545     sreftest($helem{$i}, $i++);
 546     sreftest $aelem[0], $i++;
 547 }
 548
 549 # test prototypes when they are evaled and there is a syntax error
 550 # Byacc generates the string "syntax error".  Bison gives the
 551 # string "parse error".
 552 #
 553 for my $p ( "", qw{ () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@) } ) {
 554   my $warn = "";
 555   local $SIG{__WARN__} = sub {
 556     my $thiswarn = join("",@_);
 557     return if $thiswarn =~ /^Prototype mismatch: sub main::evaled_subroutine/;
 558     $warn .= $thiswarn;
 559   };
 560   my $eval = "sub evaled_subroutine $p { &void *; }";
 561   eval $eval;
 562   print "# eval[$eval]\nnot " unless $@ && $@ =~ /(parse|syntax) error/i;
 563   print "ok ", $i++, "\n";
 564   if ($warn eq '') {
 565      print "ok ", $i++, "\n";
 566   } else {
 567     print "not ok ", $i++, "# $warn \n";
 568   }
 569 }
 570
 571 # Not $$;$;$
 572 print "not " unless prototype "CORE::substr" eq '$$;$$';
 573 print "ok ", $i++, "\n";
 574
 575 # recv takes a scalar reference for its second argument
 576 print "not " unless prototype "CORE::recv" eq '*\\$$$';
 577 print "ok ", $i++, "\n";
 578
 579 {
 580     my $myvar;
 581     my @myarray;
 582     my %myhash;
 583     sub mysub { print "not calling mysub I hope\n" }
 584     local *myglob;
 585
 586     sub myref (\[$@%&*]) { print "# $_[0]\n"; return "$_[0]" }
 587
 588     print "not " unless myref($myvar)   =~ /^SCALAR\(/;
 589     print "ok ", $i++, "\n";
 590     print "not " unless myref(@myarray) =~ /^ARRAY\(/;
 591     print "ok ", $i++, "\n";
 592     print "not " unless myref(%myhash)  =~ /^HASH\(/;
 593     print "ok ", $i++, "\n";
 594     print "not " unless myref(&mysub)   =~ /^CODE\(/;
 595     print "ok ", $i++, "\n";
 596     print "not " unless myref(*myglob)  =~ /^GLOB\(/;
 597     print "ok ", $i++, "\n";
 598
 599     eval q/sub multi1 (\[%@]) { 1 } multi1 $myvar;/;
 600     print "not "
 601         unless $@ =~ /Type of arg 1 to main::multi1 must be one of \[%\@\] /;
 602     print "ok ", $i++, "\n";
 603     eval q/sub multi2 (\[$*&]) { 1 } multi2 @myarray;/;
 604     print "not "
 605         unless $@ =~ /Type of arg 1 to main::multi2 must be one of \[\$\*&\] /;
 606     print "ok ", $i++, "\n";
 607     eval q/sub multi3 (\[$@]) { 1 } multi3 %myhash;/;
 608     print "not "
 609         unless $@ =~ /Type of arg 1 to main::multi3 must be one of \[\$\@\] /;
 610     print "ok ", $i++, "\n";
 611     eval q/sub multi4 ($\[%]) { 1 } multi4 1, &mysub;/;
 612     print "not "
 613         unless $@ =~ /Type of arg 2 to main::multi4 must be one of \[%\] /;
 614     print "ok ", $i++, "\n";
 615     eval q/sub multi5 (\[$@]$) { 1 } multi5 *myglob;/;
 616     print "not "
 617         unless $@ =~ /Type of arg 1 to main::multi5 must be one of \[\$\@\] /
 618             && $@ =~ /Not enough arguments/;
 619     print "ok ", $i++, "\n";
 620 }
 621
 622 # check that obviously bad prototypes are getting warnings
 623 {
 624   local $^W = 1;
 625   my $warn = "";
 626   local $SIG{__WARN__} = sub { $warn .= join("",@_) };
 627
 628   eval 'sub badproto (@bar) { 1; }';
 629   print "not " unless $warn =~ /Illegal character in prototype for main::badproto : \@bar/;
 630   print "ok ", $i++, "\n";
 631
 632   eval 'sub badproto2 (bar) { 1; }';
 633   print "not " unless $warn =~ /Illegal character in prototype for main::badproto2 : bar/;
 634   print "ok ", $i++, "\n";
 635
 636   eval 'sub badproto3 (&$bar$@) { 1; }';
 637   print "not " unless $warn =~ /Illegal character in prototype for main::badproto3 : &\$bar\$\@/;
 638   print "ok ", $i++, "\n";
 639
 640   eval 'sub badproto4 (@ $b ar) { 1; }';
 641   print "not " unless $warn =~ /Illegal character in prototype for main::badproto4 : \@\$bar/;
 642   print "ok ", $i++, "\n";
 643 }
 644
 645 # make sure whitespace in prototypes works
 646 eval "sub good (\$\t\$\n\$) { 1; }";
 647 print "not " if $@;
 648 print "ok ", $i++, "\n";
 649
 650 # Ought to fail, doesn't in 5.8.1.
 651 eval 'sub bug (\[%@]) {  } my $array = [0 .. 1]; bug %$array;';
 652 print "not " unless $@ =~ /Not a HASH reference/;
 653 print "ok ", $i++, "\n";
 654
 655 # [perl #75904]
 656 # Test that the following prototypes make subs parse as unary functions:
 657 #  * \sigil \[...] ;$ ;* ;\sigil ;\[...]
 658 print "not "
 659  unless eval 'sub uniproto1 (*) {} uniproto1 $_, 1' or warn $@;
 660 print "ok ", $i++, "\n";
 661 print "not "
 662  unless eval 'sub uniproto2 (\$) {} uniproto2 $_, 1' or warn $@;
 663 print "ok ", $i++, "\n";
 664 print "not "
 665  unless eval 'sub uniproto3 (\[$%]) {} uniproto3 %_, 1' or warn $@;
 666 print "ok ", $i++, "\n";
 667 print "not "
 668  unless eval 'sub uniproto4 (;$) {} uniproto4 $_, 1' or warn $@;
 669 print "ok ", $i++, "\n";
 670 print "not "
 671  unless eval 'sub uniproto5 (;*) {} uniproto5 $_, 1' or warn $@;
 672 print "ok ", $i++, "\n";
 673 print "not "
 674  unless eval 'sub uniproto6 (;\@) {} uniproto6 @_, 1' or warn $@;
 675 print "ok ", $i++, "\n";
 676 print "not "
 677  unless eval 'sub uniproto7 (;\[$%@]) {} uniproto7 @_, 1' or warn $@;
 678 print "ok ", $i++, "\n";