[perl #115742] Push a new pad for recursive DB::DB

When invoking the debugger recursively, pp_dbstate needs to push a new
pad (like pp_entersub) so that DB::DB doesn’t stomp on the lexical
variables belonging to the outer call.

diff --git a/pp_ctl.c b/pp_ctl.c
index 5374e0f..24eac16 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2000,8 +2000,12 @@ PP(pp_dbstate)
            PUSHSUB_DB(cx);
            cx->blk_sub.retop = PL_op->op_next;
            CvDEPTH(cv)++;
+           if (CvDEPTH(cv) >= 2) {
+               PERL_STACK_OVERFLOW_CHECK();
+               pad_push(CvPADLIST(cv), CvDEPTH(cv));
+           }
            SAVECOMPPAD();
-           PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
+           PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
            RETURNOP(CvSTART(cv));
        }
     }

diff --git a/t/run/switchd.t b/t/run/switchd.t
index 9194062..d2a56bb 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 => 9);
+plan(tests => 10);
 
 my $r;
 
@@ -130,3 +130,30 @@ like(
   qr/^No DB::DB routine defined/,
   "No crash when &DB::DB exists but isn't actually defined",
 );
+
+# [perl #115742] Recursive DB::DB clobbering its own pad
+like(
+  runperl(
+    switches => [ '-Ilib' ],
+    progs    => [ split "\n", <<'='
+     BEGIN {
+      $^P = 0x22;
+     }
+     package DB;
+     sub DB {
+      my $x = 42;
+      return if $__++;
+      $^D |= 1 << 30; # allow recursive calls
+      main::foo();
+      print $x//q-u-, qq-\n-;
+     }
+     package main;
+     chop;
+     sub foo { chop; }
+=
+    ],
+    stderr   => 1,
+  ),
+  qr/42/,
+  "Recursive DB::DB does not clobber its own pad",
+);