1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc( qw(../lib) );
7    plan (tests => 22); # some tests are run in BEGIN block
8}
9
10is __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
17use feature 'current_sub';
18
19is __SUB__, undef, '__SUB__ returns undef outside of a subroutine';
20is +()=__SUB__, 1, '__SUB__ returns undef in list context';
21
22sub foo { __SUB__ }
23is foo, \&foo, '__SUB__ inside a named subroutine';
24is foo->(), \&foo, '__SUB__ is callable';
25is ref foo, 'CODE', '__SUB__ is a code reference';
26
27my $subsub = sub { __SUB__ };
28is &$subsub, $subsub, '__SUB__ inside anonymous non-closure';
29
30my @subsubs;
31for 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.
36is $subsubs[0]()(0), 1, '__SUB__ inside closure (1)';
37is $subsubs[1]()(0), 2, '__SUB__ inside closure (2)';
38is $subsubs[2]()(0), 3, '__SUB__ inside closure (3)';
39
40BEGIN {
41    return "begin 1" if @_;
42    is CORE::__SUB__->(0), "begin 1", 'in BEGIN block'
43}
44BEGIN {
45    return "begin 2" if @_;
46    is &CORE::__SUB__->(0), "begin 2", 'in BEGIN block via & (unoptimised)'
47}
48
49sub bar;
50sub bar {
51    () = sort {
52          is  CORE::__SUB__, \&bar,   'in sort block in sub with forw decl'
53         } 1,2;
54}
55bar();
56sub bur;
57sub bur {
58    () = sort {
59          is &CORE::__SUB__, \&bur, '& in sort block in sub with forw decl'
60         } 1,2;
61}
62bur();
63
64sub squog;
65sub squog {
66    grep { is  CORE::__SUB__, \&squog,
67          'in grep block in sub with forw decl'
68    } 1;
69}
70squog();
71sub squag;
72sub squag {
73    grep { is &CORE::__SUB__, \&squag,
74          '& in grep block in sub with forw decl'
75    } 1;
76}
77squag();
78
79sub f () { __SUB__ }
80is f, \&f, 'sub named () { __SUB__ } returns self ref';
81my $f = sub () { __SUB__ };
82is &$f, $f, 'anonymous sub(){__SUB__} returns self ref';
83my $f2 = sub () { $f++ if 0; __SUB__ };
84is &$f2, $f2, 'sub(){__SUB__} anonymous closure returns self ref';
85$f = sub () { eval ""; __SUB__ };
86is &$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
97