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