From a6d695237c4c14fa287df157c4907e01d4647641 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 2 Oct 2014 15:54:58 +1000
Subject: [perl #122445] use magic on $DB::single etc to avoid overload issues

This prevents perl recursing infinitely when an overloaded object is
assigned to $DB::single, $DB::trace or $DB::signal

This is done by referencing their values as IVs instead of as SVs in
dbstate, and by adding magic to those variables so that assignments to
the scalars update the PL_DBcontrol array.
---
 perl.c | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

(limited to 'perl.c')

diff --git a/perl.c b/perl.c
index f11bcb4b95..5acd88368c 100644
--- a/perl.c
+++ b/perl.c
@@ -968,6 +968,9 @@ perl_destruct(pTHXx)
     PL_DBsingle = NULL;
     PL_DBtrace = NULL;
     PL_DBsignal = NULL;
+    PL_DBsingle_iv = 0;
+    PL_DBtrace_iv = 0;
+    PL_DBsignal_iv = 0;
     PL_DBcv = NULL;
     PL_dbargs = NULL;
     PL_debstash = NULL;
@@ -2389,7 +2392,7 @@ S_run_body(pTHX_ I32 oldscope)
 	    my_exit(0);
 	}
 	if (PERLDB_SINGLE && PL_DBsingle)
-	    sv_setiv(PL_DBsingle, 1);
+            PL_DBsingle_iv = 1;
 	if (PL_initav) {
 	    PERL_SET_PHASE(PERL_PHASE_INIT);
 	    call_list(oldscope, PL_initav);
@@ -3957,6 +3960,7 @@ void
 Perl_init_debugger(pTHX)
 {
     HV * const ostash = PL_curstash;
+    MAGIC *mg;
 
     PL_curstash = (HV *)SvREFCNT_inc_simple(PL_debstash);
 
@@ -3973,12 +3977,24 @@ Perl_init_debugger(pTHX)
     PL_DBsingle = GvSV((gv_fetchpvs("DB::single", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBsingle))
 	sv_setiv(PL_DBsingle, 0);
+    mg = sv_magicext(PL_DBsingle, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_SINGLE;
+    SvSETMAGIC(PL_DBsingle);
+
     PL_DBtrace = GvSV((gv_fetchpvs("DB::trace", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBtrace))
 	sv_setiv(PL_DBtrace, 0);
+    mg = sv_magicext(PL_DBtrace, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_TRACE;
+    SvSETMAGIC(PL_DBtrace);
+
     PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBsignal))
 	sv_setiv(PL_DBsignal, 0);
+    mg = sv_magicext(PL_DBsignal, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_SIGNAL;
+    SvSETMAGIC(PL_DBsignal);
+
     SvREFCNT_dec(PL_curstash);
     PL_curstash = ostash;
 }
-- 
cgit v1.2.1