Commit | Line | Data |
---|---|---|
84ed0108 FC |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
a817e89d | 4 | chdir 't' if -d 't'; |
84ed0108 FC |
5 | @INC = qw(../lib); |
6 | require './test.pl'; | |
8915ba3d | 7 | plan (tests => 22); |
84ed0108 FC |
8 | } |
9 | ||
84ed0108 FC |
10 | is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature'; |
11 | ||
12 | { | |
13 | use v5.15; | |
14 | is __SUB__, undef, '__SUB__ under use v5.16'; | |
15 | } | |
16 | ||
17 | use feature 'current_sub'; | |
18 | ||
19 | is __SUB__, undef, '__SUB__ returns undef outside of a subroutine'; | |
20 | is +()=__SUB__, 1, '__SUB__ returns undef in list context'; | |
21 | ||
22 | sub foo { __SUB__ } | |
23 | is foo, \&foo, '__SUB__ inside a named subroutine'; | |
24 | is foo->(), \&foo, '__SUB__ is callable'; | |
25 | is ref foo, 'CODE', '__SUB__ is a code reference'; | |
26 | ||
27 | my $subsub = sub { __SUB__ }; | |
28 | is &$subsub, $subsub, '__SUB__ inside anonymous non-closure'; | |
29 | ||
30 | my @subsubs; | |
31 | for my $x(1..3) { | |
32 | push @subsubs, sub { return $x if @_; __SUB__ }; | |
33 | } | |
34 | # Don’t loop here; we need to avoid interactions between the iterator | |
35 | # and the closure. | |
36 | is $subsubs[0]()(0), 1, '__SUB__ inside closure (1)'; | |
37 | is $subsubs[1]()(0), 2, '__SUB__ inside closure (2)'; | |
38 | is $subsubs[2]()(0), 3, '__SUB__ inside closure (3)'; | |
e157a82b FC |
39 | |
40 | BEGIN { | |
41 | return "begin 1" if @_; | |
42 | is CORE::__SUB__->(0), "begin 1", 'in BEGIN block' | |
43 | } | |
44 | BEGIN { | |
45 | return "begin 2" if @_; | |
46 | is &CORE::__SUB__->(0), "begin 2", 'in BEGIN block via & (unoptimised)' | |
47 | } | |
d7ab38e8 FC |
48 | |
49 | sub bar; | |
50 | sub bar { | |
51 | () = sort { | |
52 | is CORE::__SUB__, \&bar, 'in sort block in sub with forw decl' | |
53 | } 1,2; | |
54 | } | |
55 | bar(); | |
56 | sub bur; | |
57 | sub bur { | |
58 | () = sort { | |
59 | is &CORE::__SUB__, \&bur, '& in sort block in sub with forw decl' | |
60 | } 1,2; | |
61 | } | |
62 | bur(); | |
63 | ||
64 | sub squog; | |
65 | sub squog { | |
66 | grep { is CORE::__SUB__, \&squog, | |
67 | 'in grep block in sub with forw decl' | |
68 | } 1; | |
69 | } | |
70 | squog(); | |
71 | sub squag; | |
72 | sub squag { | |
73 | grep { is &CORE::__SUB__, \&squag, | |
74 | '& in grep block in sub with forw decl' | |
75 | } 1; | |
76 | } | |
77 | squag(); | |
ed6401c5 FC |
78 | |
79 | sub f () { __SUB__ } | |
80 | is f, \&f, 'sub named () { __SUB__ } returns self ref'; | |
81 | my $f = sub () { __SUB__ }; | |
82 | is &$f, $f, 'anonymous sub(){__SUB__} returns self ref'; | |
83 | my $f2 = sub () { $f++ if 0; __SUB__ }; | |
84 | is &$f2, $f2, 'sub(){__SUB__} anonymous closure returns self ref'; | |
8915ba3d FC |
85 | $f = sub () { eval ""; __SUB__ }; |
86 | is &$f, $f, 'anonymous sub(){eval ""; __SUB__} returns self ref'; | |
87 | { | |
88 | local $ENV{PERL5DB} = 'sub DB::DB {}'; | |
89 | is runperl( | |
90 | switches => [ '-d' ], | |
91 | prog => '$f = sub(){CORE::__SUB__}; print qq-ok\n- if $f == &$f;', | |
92 | ), | |
93 | "ok\n", | |
94 | 'sub(){__SUB__} under -d'; | |
95 | } | |
96 |