[perl5.git] / t / op / current_sub.t

#!./perl

BEGIN {
    chdir 't';
    @INC = qw(../lib);
    require './test.pl';
}

plan tests => 11;

is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature';

{
    use v5.15;
    is __SUB__, undef, '__SUB__ under use v5.16';
}

use feature 'current_sub';

is __SUB__, undef, '__SUB__ returns undef outside of a subroutine';
is +()=__SUB__, 1, '__SUB__ returns undef in list context';

sub foo { __SUB__ }
is foo, \&foo, '__SUB__ inside a named subroutine';
is foo->(), \&foo, '__SUB__ is callable';
is ref foo, 'CODE', '__SUB__ is a code reference';

my $subsub = sub { __SUB__ };
is &$subsub, $subsub, '__SUB__ inside anonymous non-closure';

my @subsubs;
for my $x(1..3) {
  push @subsubs, sub { return $x if @_; __SUB__ };
}
# Don’t loop here; we need to avoid interactions between the iterator
# and the closure.
is $subsubs[0]()(0), 1, '__SUB__ inside closure (1)';
is $subsubs[1]()(0), 2, '__SUB__ inside closure (2)';
is $subsubs[2]()(0), 3, '__SUB__ inside closure (3)';
Commit	Line	Data
84ed0108 FC	1	#!./perl
	2
	3	BEGIN {
	4	chdir 't';
	5	@INC = qw(../lib);
	6	require './test.pl';
	7	}
	8
	9	plan tests => 11;
	10
	11	is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature';
	12
	13	{
	14	use v5.15;
	15	is __SUB__, undef, '__SUB__ under use v5.16';
	16	}
	17
	18	use feature 'current_sub';
	19
	20	is __SUB__, undef, '__SUB__ returns undef outside of a subroutine';
	21	is +()=__SUB__, 1, '__SUB__ returns undef in list context';
	22
	23	sub foo { __SUB__ }
	24	is foo, \&foo, '__SUB__ inside a named subroutine';
	25	is foo->(), \&foo, '__SUB__ is callable';
	26	is ref foo, 'CODE', '__SUB__ is a code reference';
	27
	28	my $subsub = sub { __SUB__ };
	29	is &$subsub, $subsub, '__SUB__ inside anonymous non-closure';
	30
	31	my @subsubs;
	32	for my $x(1..3) {
	33	push @subsubs, sub { return $x if @_; __SUB__ };
	34	}
	35	# Don’t loop here; we need to avoid interactions between the iterator
	36	# and the closure.
	37	is $subsubs[0]()(0), 1, '__SUB__ inside closure (1)';
	38	is $subsubs[1]()(0), 2, '__SUB__ inside closure (2)';
	39	is $subsubs[2]()(0), 3, '__SUB__ inside closure (3)';