This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make B::Deparse emit CORE::state, etc.
[perl5.git] / dist / B-Deparse / t / core.t
1 #!./perl
2
3 BEGIN {
4     unshift @INC, 't','../../t';
5     require 'test.pl';
6     skip_all_without_dynamic_extension('B');
7 }
8
9
10 # Many functions appear in multiple lists, so that shift() and shift(foo)
11 # are both tested.
12 # For lists, we test 0 to 2 arguments.
13 my @nary = (
14  # nullary functions
15      [qw( abs alarm break chr cos chop close chdir chomp chmod chown
16           chroot caller continue die dump exp exit exec endgrent
17           endpwent endnetent endhostent endservent endprotoent fork
18           getppid getpwent getprotoent gethostent getnetent getservent
19           getgrent getlogin getc gmtime hex int lc log lstat length
20           lcfirst localtime mkdir ord oct pop quotemeta ref rand
21           rmdir reset reverse readlink select setpwent setgrent
22           shift sin sleep sqrt srand stat system tell time times
23           uc utime umask unlink ucfirst wantarray warn wait write    )],
24  # unary
25      [qw( abs alarm bless binmode chr cos chop close chdir chomp
26           chmod chown chroot closedir die dump exp exit exec
27           each fileno getpgrp getpwnam getpwuid getpeername
28           getprotobyname getprotobynumber gethostbyname
29           getnetbyname getsockname getgrnam getgrgid
30           getc gmtime hex int join keys kill lc
31           log lock lstat length lcfirst localtime
32           mkdir ord oct open pop push pack quotemeta
33           ref rand rmdir reset reverse readdir readlink
34           rewinddir select setnetent sethostent setservent
35           setprotoent shift sin sleep sprintf splice sqrt
36           srand stat system tell tied telldir uc utime umask
37           unpack unlink unshift untie ucfirst values warn write )],
38  # binary, but not infix
39      [qw( atan2 accept bind binmode chop chomp chmod chown crypt
40           connect die exec flock formline getpriority gethostbyaddr
41           getnetbyaddr getservbyname getservbyport index join kill
42           link listen mkdir msgget open opendir push pack pipe
43           rename rindex reverse seekdir semop setpgrp shutdown
44           sprintf splice substr system symlink syscall syswrite
45           tie truncate utime unpack unlink warn waitpid           )],
46  # ternary
47      [qw( fcntl getsockopt index ioctl join  kill  msgctl
48           msgsnd open push pack  read  rindex  seek  send
49           semget setpriority shmctl shmget sprintf splice
50           substr sysopen sysread sysseek syswrite tie vec )],
51  # quaternary
52      [qw( open read  recv  send  select  semctl  setsockopt  shmread
53           shmwrite socket splice substr sysopen sysread syswrite tie )],
54  # quinary
55      [qw( msgrcv open socketpair splice )]
56 );
57
58 my $tests = @bin + 13;
59 $tests += @$_ for @nary;
60 plan $tests;
61
62 use B::Deparse;
63 my $deparse = new B::Deparse;
64
65 sub CORE_test {
66   my($keyword,$expr,$name) = @_;
67   package test;
68   use subs ();
69   import subs $keyword;
70   ::like
71       $deparse->coderef2text(
72          eval "sub { () = $expr }" or die "$@in $expr"
73       ),
74       qr/\sCORE::$keyword.*;/,
75       $name||$keyword  
76 }
77
78 for my $argc(0..$#nary) {
79  for(@{$nary[$argc]}) {
80   CORE_test
81      $_,\r    "CORE::$_(" . join(',',map "\$$_", (undef,"a".."z")[1..$argc]) . ")",
82     "$_, $argc argument" . "s"x($argc != 1);
83  }
84 }
85
86 # Special cases
87 CORE_test dbmopen => 'CORE::dbmopen %foo, $bar, $baz';
88 CORE_test dbmclose => 'CORE::dbmclose %foo';
89 CORE_test eof => 'CORE::eof $foo', 'eof $arg';
90 CORE_test eof => 'CORE::eof', 'eof';
91 CORE_test eof => 'CORE::eof()', 'eof()';
92 CORE_test exec => 'CORE::exec $foo $bar', 'exec PROGRAM LIST';
93 CORE_test each => 'CORE::each %bar', 'each %hash';
94 CORE_test keys => 'CORE::keys %bar', 'keys %hash';
95 CORE_test reverse => 'CORE::reverse sort @foo', 'reverse sort';
96 CORE_test system => 'CORE::system $foo $bar', 'system PROGRAM LIST';
97 CORE_test values => 'CORE::values %bar', 'values %hash';
98 # This test does not work. How do I get Deparse to output a not?
99 #CORE_test not => 'CORE::not $a, $b', 'not';
100 CORE_test readline => 'CORE::readline $a.$b', 'readline';
101 CORE_test readpipe => 'CORE::readpipe $a+$b', 'readpipe';
102
103 # Tests for prefixing feature.pm-enabled keywords with CORE:: when
104 # feature.pm is not enabled are in deparse.t, as they fit that for-
105 # mat better.