Don’t crash with existent but undefined &DB::DB

This is a follow-up to 432d4561c48, which fixed *DB::DB without
&DB::DB, but not &DB::DB without body.

diff --git a/pp_ctl.c b/pp_ctl.c
index b26e557..3faa9b0 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1969,7 +1969,7 @@ PP(pp_dbstate)
         if (gv && isGV_with_GP(gv))
             cv = GvCV(gv);
 
-       if (!cv)
+       if (!cv || (!CvROOT(cv) && !CvXSUB(cv)))
            DIE(aTHX_ "No DB::DB routine defined");
 
        if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG))

diff --git a/t/run/switchd.t b/t/run/switchd.t
index 1dffb2d..9194062 100644 (file)
--- a/t/run/switchd.t
+++ b/t/run/switchd.t
@@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; }
 
 # This test depends on t/lib/Devel/switchd*.pm.
 
-plan(tests => 8);
+plan(tests => 9);
 
 my $r;
 
@@ -119,5 +119,14 @@ like(
     stderr   => 1,
   ),
   qr/^No DB::DB routine defined/,
-  "No crash when DB::DB isn't actually defined",
+  "No crash when *DB::DB exists but not &DB::DB",
+);
+like(
+  runperl(
+    switches => [ '-Ilib' ],
+    prog     => 'sub DB::DB; BEGIN { $^P = 0x22; } for(0..9){ warn }',
+    stderr   => 1,
+  ),
+  qr/^No DB::DB routine defined/,
+  "No crash when &DB::DB exists but isn't actually defined",
 );