This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move the do() test in Deparse’s core.t
[perl5.git] / dist / B-Deparse / t / core.t
CommitLineData
4a1ac32e
FC
1#!./perl
2
3BEGIN {
9ee672c4
NC
4 require Config;
5 if (($Config::Config{extensions} !~ /\bB\b/) ){
6 print "1..0 # Skip -- Perl configured without B module\n";
7 exit 0;
8 }
4a1ac32e
FC
9}
10
9ee672c4
NC
11use strict;
12use Test::More;
4a1ac32e
FC
13
14# Many functions appear in multiple lists, so that shift() and shift(foo)
15# are both tested.
16# For lists, we test 0 to 2 arguments.
17my @nary = (
18 # nullary functions
19 [qw( abs alarm break chr cos chop close chdir chomp chmod chown
03dcbf21 20 chroot caller continue die dump exp exit exec endgrent
a32fbbd8 21 endpwent endnetent endhostent endservent endprotoent fork glob
4a1ac32e
FC
22 getppid getpwent getprotoent gethostent getnetent getservent
23 getgrent getlogin getc gmtime hex int lc log lstat length
24 lcfirst localtime mkdir ord oct pop quotemeta ref rand
25 rmdir reset reverse readlink select setpwent setgrent
26 shift sin sleep sqrt srand stat system tell time times
27 uc utime umask unlink ucfirst wantarray warn wait write )],
28 # unary
29 [qw( abs alarm bless binmode chr cos chop close chdir chomp
03dcbf21 30 chmod chown chroot closedir die do dump exp exit exec
4a1ac32e
FC
31 each fileno getpgrp getpwnam getpwuid getpeername
32 getprotobyname getprotobynumber gethostbyname
33 getnetbyname getsockname getgrnam getgrgid
a32fbbd8 34 getc glob gmtime hex int join keys kill lc
4a1ac32e
FC
35 log lock lstat length lcfirst localtime
36 mkdir ord oct open pop push pack quotemeta
37 ref rand rmdir reset reverse readdir readlink
38 rewinddir select setnetent sethostent setservent
39 setprotoent shift sin sleep sprintf splice sqrt
40 srand stat system tell tied telldir uc utime umask
41 unpack unlink unshift untie ucfirst values warn write )],
f8c20169 42 # binary, but not infix
4a1ac32e
FC
43 [qw( atan2 accept bind binmode chop chomp chmod chown crypt
44 connect die exec flock formline getpriority gethostbyaddr
45 getnetbyaddr getservbyname getservbyport index join kill
46 link listen mkdir msgget open opendir push pack pipe
47 rename rindex reverse seekdir semop setpgrp shutdown
48 sprintf splice substr system symlink syscall syswrite
49 tie truncate utime unpack unlink warn waitpid )],
50 # ternary
51 [qw( fcntl getsockopt index ioctl join kill msgctl
52 msgsnd open push pack read rindex seek send
53 semget setpriority shmctl shmget sprintf splice
54 substr sysopen sysread sysseek syswrite tie vec )],
55 # quaternary
56 [qw( open read recv send select semctl setsockopt shmread
57 shmwrite socket splice substr sysopen sysread syswrite tie )],
58 # quinary
59 [qw( msgrcv open socketpair splice )]
60);
61
4a1ac32e
FC
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(
9ee672c4 72 eval "no strict 'vars'; sub { () = $expr }" or die "$@in $expr"
4a1ac32e
FC
73 ),
74 qr/\sCORE::$keyword.*;/,
75 $name||$keyword
76}
77
78for my $argc(0..$#nary) {
79 for(@{$nary[$argc]}) {
80 CORE_test
9ee672c4
NC
81 $_,
82 "CORE::$_(" . join(',',map "\$$_", (undef,"a".."z")[1..$argc]) . ")",
4a1ac32e
FC
83 "$_, $argc argument" . "s"x($argc != 1);
84 }
85}
86
87# Special cases
88CORE_test dbmopen => 'CORE::dbmopen %foo, $bar, $baz';
89CORE_test dbmclose => 'CORE::dbmclose %foo';
90CORE_test eof => 'CORE::eof $foo', 'eof $arg';
91CORE_test eof => 'CORE::eof', 'eof';
92CORE_test eof => 'CORE::eof()', 'eof()';
93CORE_test exec => 'CORE::exec $foo $bar', 'exec PROGRAM LIST';
94CORE_test each => 'CORE::each %bar', 'each %hash';
95CORE_test keys => 'CORE::keys %bar', 'keys %hash';
96CORE_test reverse => 'CORE::reverse sort @foo', 'reverse sort';
97CORE_test system => 'CORE::system $foo $bar', 'system PROGRAM LIST';
98CORE_test values => 'CORE::values %bar', 'values %hash';
ca47a8ce 99CORE_test not => '3 unless CORE::not $a && $b', 'not';
4a1ac32e
FC
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.
9ee672c4
NC
106
107done_testing();