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