[perl #80628] __SUB__

After much alternation, altercation and alteration, __SUB__ is
finally here.

3 files changed, 44 insertions, 1 deletions

diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index d3f03eb58a..4285157fe7 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -235,10 +235,13 @@ sub test_proto {
 test_proto '__FILE__';
 test_proto '__LINE__';
 test_proto '__PACKAGE__';
+test_proto '__SUB__';
 
 is file(), 'frob'    , '__FILE__ does check its caller'   ; ++ $tests;
 is line(),  5        , '__LINE__ does check its caller'   ; ++ $tests;
 is pakg(), 'stribble', '__PACKAGE__ does check its caller'; ++ $tests;
+sub __SUB__test { &my__SUB__ }
+is __SUB__test, \&__SUB__test, '&__SUB__';                  ++ $tests;
 
 test_proto 'abs', -5, 5;
 
diff --git a/t/op/cproto.t b/t/op/cproto.t
index ad2249df2c..dabb4bc4a6 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 BEGIN { require './test.pl'; }
-plan tests => 246;
+plan tests => 247;
 
 while (<DATA>) {
     chomp;
@@ -32,6 +32,7 @@ __LINE__ ()
 __PACKAGE__ ()
 __DATA__ undef
 __END__ undef
+__SUB__ ()
 CORE unknown
 abs (_)
 accept (**)
diff --git a/t/op/current_sub.t b/t/op/current_sub.t
new file mode 100644
index 0000000000..7a00032c46
--- /dev/null
+++ b/t/op/current_sub.t
@@ -0,0 +1,39 @@
+#!./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)';