Make __SUB__ work in special blocks

diff --git a/op.c b/op.c
index 6253462..24d5ecb 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10371,7 +10371,7 @@ Perl_rpeep(pTHX_ register OP *o)
        case OP_RUNCV:
            if (!(o->op_private & OPpOFFBYONE) && !CvCLONE(PL_compcv)) {
                SV *sv;
-               if (CvUNIQUE(PL_compcv)) sv = &PL_sv_undef;
+               if (CvEVAL(PL_compcv)) sv = &PL_sv_undef;
                else {
                    sv = newRV((SV *)PL_compcv);
                    sv_rvweaken(sv);

diff --git a/pp.c b/pp.c
index ba3ac1f..598a429 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -6028,7 +6028,7 @@ PP(pp_runcv)
        oldsi->si_cxix = oldcxix;
     }
     else cv = find_runcv(NULL);
-    XPUSHs(CvUNIQUE(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv)));
+    XPUSHs(CvEVAL(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv)));
     RETURN;
 }
 

diff --git a/t/op/current_sub.t b/t/op/current_sub.t
index 7a00032..e72a0c5 100644 (file)
--- a/t/op/current_sub.t
+++ b/t/op/current_sub.t
@@ -4,10 +4,9 @@ BEGIN {
     chdir 't';
     @INC = qw(../lib);
     require './test.pl';
+    plan (tests => 13);
 }
 
-plan tests => 11;
-
 is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature';
 
 {
@@ -37,3 +36,12 @@ for my $x(1..3) {
 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)';
+
+BEGIN {
+    return "begin 1" if @_;
+    is CORE::__SUB__->(0), "begin 1", 'in BEGIN block'
+}
+BEGIN {
+    return "begin 2" if @_;
+    is &CORE::__SUB__->(0), "begin 2", 'in BEGIN block via & (unoptimised)'
+}