This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add find_rundefsv2 function
[perl5.git] / t / op / coresubs.t
CommitLineData
7fa5bd9b
FC
1#!./perl
2
3# This file tests the results of calling subroutines in the CORE::
4# namespace with ampersand syntax. In other words, it tests the bodies of
5# the subroutines themselves, not the ops that they might inline themselves
6# as when called as barewords.
7
8# coreinline.t tests the inlining of these subs as ops. Since it was
9# convenient, I also put the prototype and undefinedness checking in that
10# file, even though those have nothing to do with inlining. (coreinline.t
11# reads the list in keywords.pl, which is why it’s convenient.)
12
13BEGIN {
14 chdir 't' if -d 't';
15 @INC = qw(. ../lib);
16 require "test.pl";
17 $^P |= 0x100;
18}
19# Since tests inside evals can too easily fail silently, we cannot rely
20# on done_testing. It’s much easier to count the tests as we go than to
21# declare the plan up front, so this script ends with a test that makes
22# sure the right number of tests have happened.
23
24sub lis($$;$) {
25 &is(map(@$_ ? "[@{[map $_//'~~u~~', @$_]}]" : 'nought', @_[0,1]), $_[2]);
26}
27
28# This tests that the &{} syntax respects the number of arguments implied
29# by the prototype.
30sub test_proto {
31 my($o) = shift;
32
33 # Create an alias, for the caller’s convenience.
34 *{"my$o"} = \&{"CORE::$o"};
35
36 my $p = prototype "CORE::$o";
37
38 if ($p eq '') {
39 $tests ++;
40
41 eval " &CORE::$o(1) ";
42 like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
43
44 }
45
46 else {
47 die "Please add tests for the $p prototype";
48 }
49}
50
51test_proto '__FILE__';
52test_proto '__LINE__';
53test_proto '__PACKAGE__';
54
55is file(), 'frob' , '__FILE__ does check its caller' ; ++ $tests;
56is line(), 5 , '__LINE__ does check its caller' ; ++ $tests;
57is pakg(), 'stribble', '__PACKAGE__ does check its caller'; ++ $tests;
58
0c9ebd17
FC
59test_proto 'break';
60{ $tests ++;
61 my $tmp;
62 CORE::given(1) {
63 CORE::when(1) {
64 &mybreak;
65 $tmp = 'bad';
66 }
67 }
68 is $tmp, undef, '&break';
69}
70
7fa5bd9b
FC
71test_proto 'continue';
72$tests ++;
73CORE::given(1) {
74 CORE::when(1) {
75 &mycontinue();
76 }
77 pass "&continue";
78}
79
80test_proto $_ for qw(
81 endgrent endhostent endnetent endprotoent endpwent endservent
82);
83
4d3492ca
FC
84test_proto 'fork';
85
7fa5bd9b
FC
86test_proto "get$_" for qw '
87 grent hostent login
88 netent ppid protoent
cc131e40 89 pwent servent
7fa5bd9b
FC
90';
91
92test_proto "set$_" for qw '
93 grent pwent
94';
95
96test_proto 'time';
97$tests += 2;
98like &mytime, '^\d+\z', '&time in scalar context';
99like join('-', &mytime), '^\d+\z', '&time in list context';
100
101test_proto 'times';
102$tests += 2;
103like &mytimes, '^[\d.]+\z', '&times in scalar context';
104like join('-',&mytimes), '^[\d.]+-[\d.]+-[\d.]+-[\d.]+\z',
105 '&times in list context';
106
107test_proto 'wait';
108
93f0bc49
FC
109test_proto 'wantarray';
110$tests += 4;
111my $context;
112my $cx_sub = sub {
113 $context = qw[void scalar list][&mywantarray + defined mywantarray()]
114};
115() = &$cx_sub;
116is $context, 'list', '&wantarray with caller in list context';
117scalar &$cx_sub;
118is($context, 'scalar', '&wantarray with caller in scalar context');
119&$cx_sub;
120is($context, 'void', '&wantarray with caller in void context');
121lis [&mywantarray],[wantarray], '&wantarray itself in list context';
122
7fa5bd9b
FC
123
124# Add new tests above this line.
125
126# ------------ END TESTING ----------- #
127
128is curr_test, $tests+1, 'right number of tests';
129done_testing;
130
131#line 3 frob
132
133sub file { &CORE::__FILE__ }
134sub line { &CORE::__LINE__ } # 5
135package stribble;
136sub main::pakg { &CORE::__PACKAGE__ }
137
138# Please do not add new tests here.