This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix $DB::sub in DB::goto for lexical subs
authorFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 21:49:03 +0000 (14:49 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 22:51:05 +0000 (15:51 -0700)
$ PERL5DB='sub DB::DB{}' ./perl -Ilib -XMfeature=:all -de '
    state sub f{};
    sub DB::goto { warn $DB::sub }
    $^P|=0x80;
    sub {goto &f}->()'
main::f at -e line 1.

There should not be a package name.  Lexical subs should be treated
like anonymous subs here; $DB::sub should contain a reference.

This bug was introduced recently, in ae77754ae.  Before that the
output was:

CODE(0x7fdbf102de58) at -e line 1.

Though before 9d8e4b9b3 it was:

Segmentation fault: 11

t/op/lexsub.t
util.c

index 81addda..af0fa18 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 142;
+plan 143;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -383,6 +383,24 @@ like runperl(
     "4\n2\n",
     'state subs and DB::sub under -d'
   );
+  is(
+    runperl(
+     switches => [ '-d' ],
+     progs => [ split "\n",
+      'use feature qw - lexical_subs state -;
+       no warnings q-experimental::lexical_subs-;
+       sub DB::goto{ print qq|4\n|; $_ = $DB::sub }
+       state sub foo {print qq|2\n|}
+       $^P|=0x80;
+       sub { goto &foo }->();
+       print $_ == \&foo ? qq|ok\n| : qq|$_\n|;
+      '
+     ],
+     stderr => 1
+    ),
+    "4\n2\nok\n",
+    'state subs and DB::goto under -d'
+  );
 }
 # This used to fail an assertion, but only as a standalone script
 is runperl(switches => ['-lXMfeature=:all'],
diff --git a/util.c b/util.c
index f307138..e87813b 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5349,10 +5349,10 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
     if (!PERLDB_SUB_NN) {
        GV *gv = CvGV(cv);
 
-       if (gv && !svp) {
+       if (!svp && !CvLEXICAL(cv)) {
            gv_efullname3(dbsv, gv, NULL);
        }
-       else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || !gv
+       else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || CvLEXICAL(cv)
             || strEQ(GvNAME(gv), "END")
             || ( /* Could be imported, and old sub redefined. */
                 (GvCV(gv) != cv || !S_gv_has_usable_name(aTHX_ gv))