This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix crash with lex subs under -d
authorFather Chrysostomos <sprout@cpan.org>
Thu, 28 Aug 2014 17:28:28 +0000 (10:28 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 28 Aug 2014 17:28:28 +0000 (10:28 -0700)
t/op/lexsub.t
util.c

index 8ff4927..1dfd953 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 127;
+plan 129;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -334,6 +334,25 @@ like runperl(
   eval 'sub cvgv2 {42}'; # uses the stub already present
   is foo, 42, 'defining state sub body via package sub declaration';
 }
+{
+  local $ENV{PERL5DB} = 'sub DB::DB{}';
+  is(
+    runperl(
+     switches => [ '-d' ],
+     progs => [ split "\n",
+      'use feature qw - lexical_subs state -;
+       no warnings q-experimental::lexical_subs-;
+       sub DB::sub{ print qq|4\n|; goto $DB::sub }
+       state sub foo {print qq|2\n|}
+       foo();
+      '
+     ],
+     stderr => 1
+    ),
+    "4\n2\n",
+    'state subs and DB::sub under -d'
+  );
+}
 
 # -------------------- my -------------------- #
 
@@ -658,6 +677,26 @@ like runperl(
 # We would have crashed by now if it weren’t fixed.
 pass "pad taking ownership once more of packagified my-sub";
 
+{
+  local $ENV{PERL5DB} = 'sub DB::DB{}';
+  is(
+    runperl(
+     switches => [ '-d' ],
+     progs => [ split "\n",
+      'use feature qw - lexical_subs state -;
+       no warnings q-experimental::lexical_subs-;
+       sub DB::sub{ print qq|4\n|; goto $DB::sub }
+       my sub foo {print qq|2\n|}
+       foo();
+      '
+     ],
+     stderr => 1
+    ),
+    "4\n2\n",
+    'my subs and DB::sub under -d'
+  );
+}
+
 # -------------------- Interactions (and misc tests) -------------------- #
 
 is sub {
diff --git a/util.c b/util.c
index 98b121f..dea60ac 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5350,10 +5350,10 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
     if (!PERLDB_SUB_NN) {
        GV *gv = CvGV(cv);
 
-       if (!svp) {
+       if (gv && !svp) {
            gv_efullname3(dbsv, gv, NULL);
        }
-       else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+       else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || !gv
             || strEQ(GvNAME(gv), "END")
             || ( /* Could be imported, and old sub redefined. */
                 (GvCV(gv) != cv || !S_gv_has_usable_name(aTHX_ gv))