summaryrefslogtreecommitdiff
path: root/perl.c
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2014-10-02 15:54:58 +1000
committerTony Cook <tony@develop-help.com>2014-10-09 11:24:50 +1100
commita6d695237c4c14fa287df157c4907e01d4647641 (patch)
tree77c7361b0f9c6d75fc7b703d4cc190cb16b906d3 /perl.c
parent2c2d7daa95190ae95ae6486d1734a1167ea05966 (diff)
downloadperl-a6d695237c4c14fa287df157c4907e01d4647641.tar.gz
[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.
Diffstat (limited to 'perl.c')
-rw-r--r--perl.c18
1 files changed, 17 insertions, 1 deletions
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;
}