lib/B/Deparse-core.t

   1 #!./perl
   2
   3 # Test the core keywords.
   4 #
   5 # Initially this test file just checked that CORE::foo got correctly
   6 # deparsed as CORE::foo, hence the name. It's since been expanded
   7 # to fully test both CORE:: versus none, plus that any arguments
   8 # are correctly deparsed. It also cross-checks against regen/keywords.pl
   9 # to make sure we've tested all keywords, and with the correct strength.
  10 #
  11 # A keyword can be either weak or strong. Strong keywords can never be
  12 # overridden, while weak ones can. So deparsing of weak keywords depends
  13 # on whether a sub of that name has been created:
  14 #
  15 # for both:         keyword(..) deparsed as keyword(..)
  16 # for weak:   CORE::keyword(..) deparsed as CORE::keyword(..)
  17 # for strong: CORE::keyword(..) deparsed as keyword(..)
  18 #
  19 # Three permutations of lex/nonlex args are checked for:
  20 #
  21 #   foo($a,$b,$c,...)
  22 #   foo(my $a,$b,$c,...)
  23 #   my ($a,$b,$c,...); foo($a,$b,$c,...)
  24 #
  25 # Note that tests for prefixing feature.pm-enabled keywords with CORE:: when
  26 # feature.pm is not enabled are in deparse.t, as they fit that format better.
  27
  28
  29 BEGIN {
  30     require Config;
  31     if (($Config::Config{extensions} !~ /\bB\b/) ){
  32         print "1..0 # Skip -- Perl configured without B module\n";
  33         exit 0;
  34     }
  35 }
  36
  37 use strict;
  38 use Test::More;
  39 plan tests => 3904;
  40
  41 use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
  42                                     # logic to add CORE::
  43 use B::Deparse;
  44 my $deparse = B::Deparse->new();
  45
  46 my %SEEN;
  47 my %SEEN_STRENGTH;
  48
  49 # For a given keyword, create a sub of that name,
  50 # then deparse 3 different assignment expressions
  51 # using that keyword.  See if the $expr we get back
  52 # matches $expected_expr.
  53
  54 sub testit {
  55     my ($keyword, $expr, $expected_expr, $lexsub) = @_;
  56
  57     $expected_expr //= $expr;
  58     $SEEN{$keyword} = 1;
  59
  60     # lex=0:   () = foo($a,$b,$c)
  61     # lex=1:   my ($a,$b); () = foo($a,$b,$c)
  62     # lex=2:   () = foo(my $a,$b,$c)
  63     for my $lex (0, 1, 2) {
  64         next if ($lex and $keyword =~ /local|our|state|my/);
  65         my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n    " : "";
  66
  67         if ($lex == 2) {
  68             my $repl = 'my $a';
  69             if ($expr =~ 'CORE::do') {
  70                 # do foo() is a syntax error, so B::Deparse emits
  71                 # do (foo()), but does not distinguish between foo and my,
  72                 # because it is too complicated.
  73                 $repl = '(my $a)';
  74             }
  75             s/\$a/$repl/ for $expr, $expected_expr;
  76         }
  77
  78         my $desc = "$keyword: lex=$lex $expr => $expected_expr";
  79         $desc .= " (lex sub)" if $lexsub;
  80
  81         my $code;
  82         my $code_ref;
  83         if ($lexsub) {
  84             package lexsubtest;
  85             no warnings 'experimental::lexical_subs', 'experimental::isa';
  86             use feature 'lexical_subs';
  87             no strict 'vars';
  88             $code = "sub { state sub $keyword; ${vars}() = $expr }";
  89             $code = "use feature 'isa';\n$code" if $keyword eq "isa";
  90             $code = "use feature 'switch';\n$code" if $keyword eq "break";
  91             $code_ref = eval $code or die "$@ in $expr";
  92         }
  93         else {
  94             package test;
  95             no warnings 'experimental::isa';
  96             use subs ();
  97             import subs $keyword;
  98             $code = "no strict 'vars'; sub { ${vars}() = $expr }";
  99             $code = "use feature 'isa';\n$code" if $keyword eq "isa";
 100             $code = "use feature 'switch';\n$code" if $keyword eq "break";
 101             $code_ref = eval $code or die "$@ in $expr";
 102         }
 103
 104         my $got_text = $deparse->coderef2text($code_ref);
 105
 106         unless ($got_text =~ /
 107     package (?:lexsub)?test;
 108 (?:    BEGIN \{\$\{\^WARNING_BITS\} = "[^"]+"\}
 109 )?    use strict 'refs', 'subs';
 110     use feature [^\n]+
 111 (?:    (?:CORE::)?state sub \w+;
 112 )?    \Q$vars\E\(\) = (.*)
 113 \}/s) {
 114             ::fail($desc);
 115             ::diag("couldn't extract line from boilerplate\n");
 116             ::diag($got_text);
 117             return;
 118         }
 119
 120         my $got_expr = $1;
 121         is $got_expr, $expected_expr, $desc
 122             or ::diag("ORIGINAL CODE:\n$code");;
 123     }
 124 }
 125
 126
 127 # Deparse can't distinguish 'and' from '&&' etc
 128 my %infix_map = qw(and && or ||);
 129
 130 # Test a keyword that is a binary infix operator, like 'cmp'.
 131 # $parens - "$a op $b" is deparsed as "($a op $b)"
 132 # $strong - keyword is strong
 133
 134 sub do_infix_keyword {
 135     my ($keyword, $parens, $strong) = @_;
 136     $SEEN_STRENGTH{$keyword} = $strong;
 137     my $expr = "(\$a $keyword \$b)";
 138     my $nkey = $infix_map{$keyword} // $keyword;
 139     my $expr = "(\$a $keyword \$b)";
 140     my $exp = "\$a $nkey \$b";
 141     $exp = "($exp)" if $parens;
 142     $exp .= ";";
 143     # with infix notation, a keyword is always interpreted as core,
 144     # so no need for Deparse to disambiguate with CORE::
 145     testit $keyword, "(\$a CORE::$keyword \$b)", $exp;
 146     testit $keyword, "(\$a $keyword \$b)", $exp;
 147     testit $keyword, "(\$a CORE::$keyword \$b)", $exp, 1;
 148     testit $keyword, "(\$a $keyword \$b)", $exp, 1;
 149     if (!$strong) {
 150         # B::Deparse fully qualifies any sub whose name is a keyword,
 151         # imported or not, since the importedness may not be reproduced by
 152         # the deparsed code.  x is special.
 153         my $pre = "test::" x ($keyword ne 'x');
 154         testit $keyword, "$keyword(\$a, \$b)", "$pre$keyword(\$a, \$b);";
 155     }
 156     testit $keyword, "$keyword(\$a, \$b)", "$keyword(\$a, \$b);", 1;
 157 }
 158
 159 # Test a keyword that is a standard op/function, like 'index(...)'.
 160 # $narg   - how many args to test it with
 161 # $parens - "foo $a, $b" is deparsed as "foo($a, $b)"
 162 # $dollar - an extra '$_' arg will appear in the deparsed output
 163 # $strong - keyword is strong
 164
 165
 166 sub do_std_keyword {
 167     my ($keyword, $narg, $parens, $dollar, $strong) = @_;
 168
 169     $SEEN_STRENGTH{$keyword} = $strong;
 170
 171     for my $core (0,1) { # if true, add CORE:: to keyword being deparsed
 172         for my $lexsub (0,1) { # if true, define lex sub
 173             my @code;
 174             for my $do_exp(0, 1) { # first create expr, then expected-expr
 175                 my @args = map "\$$_", (undef,"a".."z")[1..$narg];
 176                 push @args, '$_'
 177                     if $dollar && $do_exp && ($strong && !$lexsub or $core);
 178                 my $args = join(', ', @args);
 179                 # XXX $lex_parens is temporary, until lex subs are
 180                 #     deparsed properly.
 181                 my $lex_parens =
 182                     !$core && $do_exp && $lexsub && $keyword ne 'map';
 183                 $args = ((!$core && !$strong) || $parens || $lex_parens)
 184                     ? "($args)"
 185                     :  @args
 186                         ? " $args"
 187                         : "";
 188                 push @code, (
 189                     ($core && !($do_exp && $strong))
 190                     ? "CORE::"
 191                     : $lexsub && $do_exp
 192                         ? "CORE::" x $core
 193                         : $do_exp && !$core && !$strong
 194                             ? "test::"
 195                             : ""
 196                 ) . "$keyword$args;";
 197             }
 198             # code[0]: to run; code[1]: expected
 199             testit $keyword, @code, $lexsub;
 200         }
 201     }
 202 }
 203
 204
 205 while (<DATA>) {
 206     chomp;
 207     s/#.*//;
 208     next unless /\S/;
 209
 210     my @fields = split;
 211     die "not 3 fields" unless @fields == 3;
 212     my ($keyword, $args, $flags) = @fields;
 213
 214     $args = '012' if $args eq '@';
 215
 216     my $parens  = $flags =~ s/p//;
 217     my $invert1 = $flags =~ s/1//;
 218     my $dollar  = $flags =~ s/\$//;
 219     my $strong  = $flags =~ s/\+//;
 220     die "unrecognised flag(s): '$flags'" unless $flags =~ /^-?$/;
 221
 222     if ($args eq 'B') { # binary infix
 223         die "$keyword: binary (B) op can't have '\$' flag\\n" if $dollar;
 224         die "$keyword: binary (B) op can't have '1' flag\\n" if $invert1;
 225         do_infix_keyword($keyword, $parens, $strong);
 226     }
 227     else {
 228         my @narg = split //, $args;
 229         for my $n (0..$#narg) {
 230             my $narg = $narg[$n];
 231             my $p = $parens;
 232             $p = !$p if ($n == 0 && $invert1);
 233             do_std_keyword($keyword, $narg, $p, (!$n && $dollar), $strong);
 234         }
 235     }
 236 }
 237
 238
 239 # Special cases
 240
 241 testit dbmopen  => 'CORE::dbmopen(%foo, $bar, $baz);';
 242 testit dbmclose => 'CORE::dbmclose %foo;';
 243
 244 testit delete   => 'CORE::delete $h{\'foo\'};', 'delete $h{\'foo\'};';
 245 testit delete   => 'CORE::delete $h{\'foo\'};', undef, 1;
 246 testit delete   => 'CORE::delete @h{\'foo\'};', undef, 1;
 247 testit delete   => 'CORE::delete $h[0];', undef, 1;
 248 testit delete   => 'CORE::delete @h[0];', undef, 1;
 249 testit delete   => 'delete $h{\'foo\'};',       'delete $h{\'foo\'};';
 250
 251 # do is listed as strong, but only do { block } is strong;
 252 # do $file is weak,  so test it separately here
 253 testit do       => 'CORE::do $a;';
 254 testit do       => 'do $a;',                    'test::do($a);';
 255 testit do       => 'CORE::do { 1 }',
 256                    "do {\n        1\n    };";
 257 testit do       => 'CORE::do { 1 }',
 258                    "CORE::do {\n        1\n    };", 1;
 259 testit do       => 'do { 1 };',
 260                    "do {\n        1\n    };";
 261
 262 testit each     => 'CORE::each %bar;';
 263 testit each     => 'CORE::each @foo;';
 264
 265 testit eof      => 'CORE::eof();';
 266
 267 testit exists   => 'CORE::exists $h{\'foo\'};', 'exists $h{\'foo\'};';
 268 testit exists   => 'CORE::exists $h{\'foo\'};', undef, 1;
 269 testit exists   => 'CORE::exists &foo;', undef, 1;
 270 testit exists   => 'CORE::exists $h[0];', undef, 1;
 271 testit exists   => 'exists $h{\'foo\'};',       'exists $h{\'foo\'};';
 272
 273 testit exec     => 'CORE::exec($foo $bar);';
 274
 275 testit glob     => 'glob;',                       'glob($_);';
 276 testit glob     => 'CORE::glob;',                 'CORE::glob($_);';
 277 testit glob     => 'glob $a;',                    'glob($a);';
 278 testit glob     => 'CORE::glob $a;',              'CORE::glob($a);';
 279
 280 testit grep     => 'CORE::grep { $a } $b, $c',    'grep({$a;} $b, $c);';
 281
 282 testit keys     => 'CORE::keys %bar;';
 283 testit keys     => 'CORE::keys @bar;';
 284
 285 testit map      => 'CORE::map { $a } $b, $c',    'map({$a;} $b, $c);';
 286
 287 testit not      => '3 unless CORE::not $a && $b;';
 288
 289 testit pop      => 'CORE::pop @foo;';
 290
 291 testit push     => 'CORE::push @foo;',           'CORE::push(@foo);';
 292 testit push     => 'CORE::push @foo, 1;',        'CORE::push(@foo, 1);';
 293 testit push     => 'CORE::push @foo, 1, 2;',     'CORE::push(@foo, 1, 2);';
 294
 295 testit readline => 'CORE::readline $a . $b;';
 296
 297 testit readpipe => 'CORE::readpipe $a + $b;';
 298
 299 testit reverse  => 'CORE::reverse sort(@foo);';
 300
 301 testit shift    => 'CORE::shift @foo;';
 302
 303 testit splice   => q{CORE::splice @foo;},                 q{CORE::splice(@foo);};
 304 testit splice   => q{CORE::splice @foo, 0;},              q{CORE::splice(@foo, 0);};
 305 testit splice   => q{CORE::splice @foo, 0, 1;},           q{CORE::splice(@foo, 0, 1);};
 306 testit splice   => q{CORE::splice @foo, 0, 1, 'a';},      q{CORE::splice(@foo, 0, 1, 'a');};
 307 testit splice   => q{CORE::splice @foo, 0, 1, 'a', 'b';}, q{CORE::splice(@foo, 0, 1, 'a', 'b');};
 308
 309 # note that the test does '() = split...' which is why the
 310 # limit is optimised to 1
 311 testit split    => 'split;',                     q{split(' ', $_, 1);};
 312 testit split    => 'CORE::split;',               q{split(' ', $_, 1);};
 313 testit split    => 'split $a;',                  q{split(/$a/u, $_, 1);};
 314 testit split    => 'CORE::split $a;',            q{split(/$a/u, $_, 1);};
 315 testit split    => 'split $a, $b;',              q{split(/$a/u, $b, 1);};
 316 testit split    => 'CORE::split $a, $b;',        q{split(/$a/u, $b, 1);};
 317 testit split    => 'split $a, $b, $c;',          q{split(/$a/u, $b, $c);};
 318 testit split    => 'CORE::split $a, $b, $c;',    q{split(/$a/u, $b, $c);};
 319
 320 testit sub      => 'CORE::sub { $a, $b }',
 321                         "sub {\n        \$a, \$b;\n    }\n    ;";
 322
 323 testit system   => 'CORE::system($foo $bar);';
 324
 325 testit unshift  => 'CORE::unshift @foo;',        'CORE::unshift(@foo);';
 326 testit unshift  => 'CORE::unshift @foo, 1;',     'CORE::unshift(@foo, 1);';
 327 testit unshift  => 'CORE::unshift @foo, 1, 2;',  'CORE::unshift(@foo, 1, 2);';
 328
 329 testit values   => 'CORE::values %bar;';
 330 testit values   => 'CORE::values @foo;';
 331
 332
 333 # XXX These are deparsed wrapped in parens.
 334 # whether they should be, I don't know!
 335
 336 testit dump     => '(CORE::dump);';
 337 testit dump     => '(CORE::dump FOO);';
 338 testit goto     => '(CORE::goto);',     '(goto);';
 339 testit goto     => '(CORE::goto FOO);', '(goto FOO);';
 340 testit last     => '(CORE::last);',     '(last);';
 341 testit last     => '(CORE::last FOO);', '(last FOO);';
 342 testit next     => '(CORE::next);',     '(next);';
 343 testit next     => '(CORE::next FOO);', '(next FOO);';
 344 testit redo     => '(CORE::redo);',     '(redo);';
 345 testit redo     => '(CORE::redo FOO);', '(redo FOO);';
 346 testit redo     => '(CORE::redo);',     '(redo);';
 347 testit redo     => '(CORE::redo FOO);', '(redo FOO);';
 348 testit return   => '(return);',         '(return);';
 349 testit return   => '(CORE::return);',   '(return);';
 350
 351 # these are the keywords I couldn't think how to test within this framework
 352
 353 my %not_tested = map { $_ => 1} qw(
 354     __DATA__
 355     __END__
 356     __FILE__
 357     __LINE__
 358     __PACKAGE__
 359     AUTOLOAD
 360     BEGIN
 361     CHECK
 362     CORE
 363     DESTROY
 364     END
 365     INIT
 366     UNITCHECK
 367     catch
 368     default
 369     else
 370     elsif
 371     for
 372     foreach
 373     format
 374     given
 375     if
 376     m
 377     no
 378     package
 379     q
 380     qq
 381     qr
 382     qw
 383     qx
 384     require
 385     s
 386     tr
 387     try
 388     unless
 389     until
 390     use
 391     when
 392     while
 393     y
 394 );
 395
 396 # Sanity check against keyword data:
 397 # make sure we haven't missed any keywords,
 398 # and that we got the strength right.
 399
 400 SKIP:
 401 {
 402     skip "sanity checks when not PERL_CORE", 1 unless defined $ENV{PERL_CORE};
 403     my $count = 0;
 404     my $file = '../regen/keywords.pl';
 405     my $pass = 1;
 406     if (open my $fh, '<', $file) {
 407         while (<$fh>) {
 408             last if /^__END__$/;
 409         }
 410         while (<$fh>) {
 411             next unless /^([+\-])(\w+)$/;
 412             my ($strength, $key) = ($1, $2);
 413             $strength = ($strength eq '+') ? 1 : 0;
 414             $count++;
 415             if (!$SEEN{$key} && !$not_tested{$key}) {
 416                 diag("keyword '$key' seen in $file, but not tested here!!");
 417                 $pass = 0;
 418             }
 419             if (exists $SEEN_STRENGTH{$key} and $SEEN_STRENGTH{$key} != $strength) {
 420                 diag("keyword '$key' strengh as seen in $file doen't match here!!");
 421                 $pass = 0;
 422             }
 423         }
 424     }
 425     else {
 426         diag("Can't open $file: $!");
 427         $pass = 0;
 428     }
 429     # insanity check
 430     if ($count < 200) {
 431         diag("Saw $count keywords: less than 200!");
 432         $pass = 0;
 433     }
 434     ok($pass, "sanity checks");
 435 }
 436
 437 __DATA__
 438 #
 439 # format:
 440 #   keyword args flags
 441 #
 442 # args consists of:
 443 #  * one of more digits indictating which lengths of args the function accepts,
 444 #  * or 'B' to indiate a binary infix operator,
 445 #  * or '@' to indicate a list function.
 446 #
 447 # Flags consists of the following (or '-' if no flags):
 448 #    + : strong keyword: can't be overrriden
 449 #    p : the args are parenthesised on deparsing;
 450 #    1 : parenthesising of 1st arg length is inverted
 451 #        so '234 p1' means: foo a1,a2;  foo(a1,a2,a3); foo(a1,a2,a3,a4)
 452 #    $ : on the first argument length, there is an implicit extra
 453 #        '$_' arg which will appear on deparsing;
 454 #        e.g. 12p$  will be tested as: foo(a1);     foo(a1,a2);
 455 #                     and deparsed as: foo(a1, $_); foo(a1,a2);
 456 #
 457 # XXX Note that we really should get this data from regen/keywords.pl
 458 # and regen/opcodes (augmented if necessary), rather than duplicating it
 459 # here.
 460
 461 __SUB__          0     -
 462 abs              01    $
 463 accept           2     p
 464 alarm            01    $
 465 and              B     -
 466 atan2            2     p
 467 bind             2     p
 468 binmode          12    p
 469 bless            1     p
 470 break            0     -
 471 caller           0     -
 472 chdir            01    -
 473 chmod            @     p1
 474 chomp            @     $
 475 chop             @     $
 476 chown            @     p1
 477 chr              01    $
 478 chroot           01    $
 479 close            01    -
 480 closedir         1     -
 481 cmp              B     -
 482 connect          2     p
 483 continue         0     -
 484 cos              01    $
 485 crypt            2     p
 486 # dbmopen  handled specially
 487 # dbmclose handled specially
 488 defined          01    $+
 489 # delete handled specially
 490 die              @     p1
 491 # do handled specially
 492 # dump handled specially
 493 # each handled specially
 494 endgrent         0     -
 495 endhostent       0     -
 496 endnetent        0     -
 497 endprotoent      0     -
 498 endpwent         0     -
 499 endservent       0     -
 500 eof              01    - # also tested specially
 501 eq               B     -
 502 eval             01    $+
 503 evalbytes        01    $
 504 exec             @     p1 # also tested specially
 505 # exists handled specially
 506 exit             01    -
 507 exp              01    $
 508 fc               01    $
 509 fcntl            3     p
 510 fileno           1     -
 511 flock            2     p
 512 fork             0     -
 513 formline         2     p
 514 ge               B     -
 515 getc             01    -
 516 getgrent         0     -
 517 getgrgid         1     -
 518 getgrnam         1     -
 519 gethostbyaddr    2     p
 520 gethostbyname    1     -
 521 gethostent       0     -
 522 getlogin         0     -
 523 getnetbyaddr     2     p
 524 getnetbyname     1     -
 525 getnetent        0     -
 526 getpeername      1     -
 527 getpgrp          1     -
 528 getppid          0     -
 529 getpriority      2     p
 530 getprotobyname   1     -
 531 getprotobynumber 1     p
 532 getprotoent      0     -
 533 getpwent         0     -
 534 getpwnam         1     -
 535 getpwuid         1     -
 536 getservbyname    2     p
 537 getservbyport    2     p
 538 getservent       0     -
 539 getsockname      1     -
 540 getsockopt       3     p
 541 # given handled specially
 542 grep             123   p+ # also tested specially
 543 # glob handled specially
 544 # goto handled specially
 545 gmtime           01    -
 546 gt               B     -
 547 hex              01    $
 548 index            23    p
 549 int              01    $
 550 ioctl            3     p
 551 isa              B     -
 552 join             13    p
 553 # keys handled specially
 554 kill             123   p
 555 # last handled specially
 556 lc               01    $
 557 lcfirst          01    $
 558 le               B     -
 559 length           01    $
 560 link             2     p
 561 listen           2     p
 562 local            1     p+
 563 localtime        01    -
 564 lock             1     -
 565 log              01    $
 566 lstat            01    $
 567 lt               B     -
 568 map              123   p+ # also tested specially
 569 mkdir            @     p$
 570 msgctl           3     p
 571 msgget           2     p
 572 msgrcv           5     p
 573 msgsnd           3     p
 574 my               123   p+ # skip with 0 args, as my() => ()
 575 ne               B     -
 576 # next handled specially
 577 # not handled specially
 578 oct              01    $
 579 open             12345 p
 580 opendir          2     p
 581 or               B     -
 582 ord              01    $
 583 our              123   p+ # skip with 0 args, as our() => ()
 584 pack             123   p
 585 pipe             2     p
 586 pop              0     1 # also tested specially
 587 pos              01    $+
 588 print            @     p$+
 589 printf           @     p$+
 590 prototype        1     +
 591 # push handled specially
 592 quotemeta        01    $
 593 rand             01    -
 594 read             34    p
 595 readdir          1     -
 596 # readline handled specially
 597 readlink         01    $
 598 # readpipe handled specially
 599 recv             4     p
 600 # redo handled specially
 601 ref              01    $
 602 rename           2     p
 603 # XXX This code prints 'Undefined subroutine &main::require called':
 604 #   use subs (); import subs 'require';
 605 #   eval q[no strict 'vars'; sub { () = require; }]; print $@;
 606 # so disable for now
 607 #require          01    $+
 608 reset            01    -
 609 # return handled specially
 610 reverse          @     p1 # also tested specially
 611 rewinddir        1     -
 612 rindex           23    p
 613 rmdir            01    $
 614 say              @     p$+
 615 scalar           1     +
 616 seek             3     p
 617 seekdir          2     p
 618 select           014   p1
 619 semctl           4     p
 620 semget           3     p
 621 semop            2     p
 622 send             34    p
 623 setgrent         0     -
 624 sethostent       1     -
 625 setnetent        1     -
 626 setpgrp          2     p
 627 setpriority      3     p
 628 setprotoent      1     -
 629 setpwent         0     -
 630 setservent       1     -
 631 setsockopt       4     p
 632 shift            0     1 # also tested specially
 633 shmctl           3     p
 634 shmget           3     p
 635 shmread          4     p
 636 shmwrite         4     p
 637 shutdown         2     p
 638 sin              01    $
 639 sleep            01    -
 640 socket           4     p
 641 socketpair       5     p
 642 sort             @     p1+
 643 # split handled specially
 644 # splice handled specially
 645 sprintf          123   p
 646 sqrt             01    $
 647 srand            01    -
 648 stat             01    $
 649 state            123   p1+ # skip with 0 args, as state() => ()
 650 study            01    $+
 651 # sub handled specially
 652 substr           234   p
 653 symlink          2     p
 654 syscall          2     p
 655 sysopen          34    p
 656 sysread          34    p
 657 sysseek          3     p
 658 system           @     p1 # also tested specially
 659 syswrite         234   p
 660 tell             01    -
 661 telldir          1     -
 662 tie              234   p
 663 tied             1     -
 664 time             0     -
 665 times            0     -
 666 truncate         2     p
 667 uc               01    $
 668 ucfirst          01    $
 669 umask            01    -
 670 undef            01    +
 671 unlink           @     p$
 672 unpack           12    p$
 673 # unshift handled specially
 674 untie            1     -
 675 utime            @     p1
 676 # values handled specially
 677 vec              3     p
 678 wait             0     -
 679 waitpid          2     p
 680 wantarray        0     -
 681 warn             @     p1
 682 write            01    -
 683 x                B     -
 684 xor              B     p