This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use C<< >> to avoid tripping a podchecker heuristic for "don't you mean F<>?"
[perl5.git] / dist / B-Deparse / t / core.t
CommitLineData
4a1ac32e
FC
1#!./perl
2
3BEGIN {
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.
13my @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 )],
f8c20169 38 # binary, but not infix
4a1ac32e
FC
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
58my $tests = @bin + 13;
59$tests += @$_ for @nary;
60plan $tests;
61
62use B::Deparse;
63my $deparse = new B::Deparse;
64
65sub CORE_test {
66 my($keyword,$expr,$name) = @_;
67 package test;
68 use subs ();
69 import subs $keyword;
4a1ac32e
FC
70 ::like
71 $deparse->coderef2text(
72 eval "sub { () = $expr }" or die "$@in $expr"
73 ),
74 qr/\sCORE::$keyword.*;/,
75 $name||$keyword
76}
77
78for 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
87CORE_test dbmopen => 'CORE::dbmopen %foo, $bar, $baz';
88CORE_test dbmclose => 'CORE::dbmclose %foo';
89CORE_test eof => 'CORE::eof $foo', 'eof $arg';
90CORE_test eof => 'CORE::eof', 'eof';
91CORE_test eof => 'CORE::eof()', 'eof()';
92CORE_test exec => 'CORE::exec $foo $bar', 'exec PROGRAM LIST';
93CORE_test each => 'CORE::each %bar', 'each %hash';
94CORE_test keys => 'CORE::keys %bar', 'keys %hash';
95CORE_test reverse => 'CORE::reverse sort @foo', 'reverse sort';
96CORE_test system => 'CORE::system $foo $bar', 'system PROGRAM LIST';
97CORE_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';
100CORE_test readline => 'CORE::readline $a.$b', 'readline';
101CORE_test readpipe => 'CORE::readpipe $a+$b', 'readpipe';
80e3f4ad
FC
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.