From 676931092db3c2dcb18850f73c49e52e554e4ece Mon Sep 17 00:00:00 2001 From: Opera Wang Date: Fri, 16 Jan 2026 00:03:28 +0800 Subject: [PATCH] fix for perl 5.42 --- Enbugger.xs | 126 +++++++++++++++++++++++++++++++++++----- lib/Enbugger.pm | 10 +++- lib/Enbugger/OnError.pm | 5 +- lib/Enbugger/perl5db.pm | 6 +- t/30break.pl | 2 +- t/31break.pl | 2 +- 6 files changed, 130 insertions(+), 21 deletions(-) diff --git a/Enbugger.xs b/Enbugger.xs index 3cbaee0..468c1e4 100644 --- a/Enbugger.xs +++ b/Enbugger.xs @@ -29,6 +29,77 @@ #define DEBUG (!!EnbuggerDebugMode) I32 EnbuggerDebugMode = 0; +static void +S_init_dbargs(pTHX) +{ + AV *const args = PL_dbargs = GvAV(gv_AVadd((gv_fetchpvs("DB::args", + GV_ADDMULTI, + SVt_PVAV)))); + + if (AvREAL(args)) { + /* Someone has already created it. + It might have entries, and if we just turn off AvREAL(), they will + "leak" until global destruction. */ + av_clear(args); + if (SvTIED_mg((const SV *)args, PERL_MAGIC_tied)) + Perl_croak(aTHX_ "Cannot set tied @DB::args"); + } + AvREIFY_only(PL_dbargs); +} + +void +Perl_init_debugger(pTHX) +{ + HV * const ostash = PL_curstash; + MAGIC *mg; + + /* Only initialize if not already done */ + if (PL_DBgv && PL_DBline && PL_DBsub && PL_DBsingle && PL_DBtrace && PL_DBsignal) + return; + + PL_curstash = (HV *)SvREFCNT_inc_simple(PL_debstash); + + S_init_dbargs(aTHX); + + /* Match original Perl behavior: just set these without decrementing old values. + * The original Perl assumes init_debugger is called only once at startup. + * We guard against multiple calls with the check above. */ + PL_DBgv = GvREFCNT_inc(gv_fetchpvs("DB::DB", GV_ADDMULTI, SVt_PVGV)); + PL_DBline = GvREFCNT_inc(gv_fetchpvs("DB::dbline", GV_ADDMULTI, SVt_PVAV)); + PL_DBsub = GvREFCNT_inc(gv_HVadd(gv_fetchpvs("DB::sub", GV_ADDMULTI, SVt_PVHV))); + + PL_DBsingle = GvSV((gv_fetchpvs("DB::single", GV_ADDMULTI, SVt_PV))); + if (!SvIOK(PL_DBsingle)) + sv_setiv(PL_DBsingle, 0); + /* Only add magic if not already present */ + if (!SvMAGICAL(PL_DBsingle) || !mg_find(PL_DBsingle, PERL_MAGIC_debugvar)) { + 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); + if (!SvMAGICAL(PL_DBtrace) || !mg_find(PL_DBtrace, PERL_MAGIC_debugvar)) { + 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); + if (!SvMAGICAL(PL_DBsignal) || !mg_find(PL_DBsignal, PERL_MAGIC_debugvar)) { + 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; +} + /* * The ENBUGGER_DEBUG environment variable toggles debugging. It is @@ -84,15 +155,13 @@ alter_cop( pTHX_ SV *rv, I32 op_type ) /* - * Change the type of the COP and the function pointer. - * - * TODO: stop hardcoding the values OP_DBSTATE and Perl_pp*. This - * could be the result of a lookup function. It is allowed + * Change only the function pointer, NOT the op_type. + * Changing op_type can confuse Perl's op cleanup code during perl_destruct + * and cause crashes in Perl_pad_free. */ cop = INT2PTR( COP*, SvIV(sv) ); - cop->op_type = op_type; - cop->op_ppaddr = - op_type == OP_DBSTATE ? Perl_pp_dbstate : Perl_pp_nextstate; + /* cop->op_type = op_type; */ /* Don't change op_type - causes cleanup crashes */ + cop->op_ppaddr = PL_ppaddr[op_type]; return; } @@ -112,9 +181,10 @@ alter_cop( pTHX_ SV *rv, I32 op_type ) */ static void compile_with_nextstate() { + Perl_ppaddr_t fn_nextstate = PL_ppaddr[OP_NEXTSTATE]; PL_ppaddr[OP_NEXTSTATE] = PL_ppaddr[OP_DBSTATE] - = Perl_pp_nextstate; + = fn_nextstate; } @@ -123,9 +193,10 @@ compile_with_nextstate() { */ static void compile_with_dbstate() { + Perl_ppaddr_t fn_dbstate = PL_ppaddr[OP_DBSTATE]; PL_ppaddr[OP_NEXTSTATE] = PL_ppaddr[OP_DBSTATE] - = Perl_pp_dbstate; + = fn_dbstate; } @@ -219,25 +290,52 @@ Enbugger_init_debugger( SV* class ) PL_perldb = PERLDB_ALL; +=pod + +Set the internal debugger signal flag directly, bypassing magic. +This is needed because Perl 5.42+ has magic on $DB::signal that +resets the value. + +=cut + +void +Enbugger_set_dbsignal( SV* class, IV value ) + CODE: + PL_DBsignal_iv = value; + +void +Enbugger_set_dbsingle( SV* class, IV value ) + CODE: + PL_DBsingle_iv = value; + + =pod Sets RMAGIC on the %_<$filename hashes. +The array reference is required because the dbfile magic's MG_OBJ +must point to the corresponding array for magic_setdbline to work. =cut void -Enbugger_set_magic_dbfile(rv) - SV *rv +Enbugger_set_magic_dbfile(hv_ref, av_ref) + SV *hv_ref + SV *av_ref INIT: HV *hv; + AV *av; CODE: - assert(SvROK(rv)); + assert(SvROK(hv_ref)); + assert(SvROK(av_ref)); - hv = (HV*) SvRV(rv); + hv = (HV*) SvRV(hv_ref); + av = (AV*) SvRV(av_ref); assert(SVt_PVHV == SvTYPE(hv)); - hv_magic(hv, NULL, PERL_MAGIC_dbfile); + assert(SVt_PVAV == SvTYPE(av)); + /* Pass the array as mg_obj so magic_setdbline can find it */ + hv_magic(hv, (GV*)av, PERL_MAGIC_dbfile); diff --git a/lib/Enbugger.pm b/lib/Enbugger.pm index 5a76d28..56a1b57 100644 --- a/lib/Enbugger.pm +++ b/lib/Enbugger.pm @@ -363,7 +363,7 @@ sub initialize_dbline { if ( not defined $file ) { *DB::dbline = []; *DB::dbline = {}; - Enbugger::set_magic_dbfile( \%DB::dbline ); + Enbugger::set_magic_dbfile( \%DB::dbline, \@DB::dbline ); } else { no strict 'refs'; @@ -406,7 +406,8 @@ sub load_file { if ( ! *$glob{HASH} ) { my %breakpoints; - Enbugger::set_magic_dbfile(\%breakpoints); + # Pass both hash and array refs - the magic needs the array reference + Enbugger::set_magic_dbfile(\%breakpoints, \@{$symname}); *$glob = \%breakpoints; } @@ -534,6 +535,11 @@ BEGIN { # Anything compiled after this statement runs will be debuggable. Enbugger->_compile_with_dbstate(); +# Restore ppaddr table during cleanup to prevent crashes in perl_destruct +END { + Enbugger->_compile_with_nextstate() if defined &Enbugger::_compile_with_nextstate; +} + ## Local Variables: ## mode: cperl ## mode: auto-fill diff --git a/lib/Enbugger/OnError.pm b/lib/Enbugger/OnError.pm index 7bff647..71c4ac0 100644 --- a/lib/Enbugger/OnError.pm +++ b/lib/Enbugger/OnError.pm @@ -95,6 +95,10 @@ sub ExceptionHandler { # Log the current exception. Enbugger->write( Carp::longmess("Received signal $_[0]") ); + # Set $@ before stopping so it's available to debugger commands + # For __DIE__, $_[0] contains the exception message + # For other signals, $_[0] contains the signal name + $@ = $_[0]; # Trigger the debugger. I did some trial and error to get # this. perl5db.pl pays attention to $DB::signal. $^P gets set (if @@ -103,7 +107,6 @@ sub ExceptionHandler { # found that I'd get popped out of the debugger. Whoops. Enbugger->stop; - $@ = $_[0]; DB::DB(); } diff --git a/lib/Enbugger/perl5db.pm b/lib/Enbugger/perl5db.pm index 6db9932..0153c31 100644 --- a/lib/Enbugger/perl5db.pm +++ b/lib/Enbugger/perl5db.pm @@ -64,10 +64,12 @@ sub _load_debugger { =cut 1 if $DB::signal; -sub _stop { +sub _stop { # perl5db looks for this to stop. - $DB::signal = 1; + # Use XS function to set the internal flag directly, bypassing magic + # that would reset the value in Perl 5.42+ + Enbugger->set_dbsignal(1); # Use at least the default debug flags. $^P |= 0x33f; diff --git a/t/30break.pl b/t/30break.pl index 12fc035..285ce77 100644 --- a/t/30break.pl +++ b/t/30break.pl @@ -83,7 +83,7 @@ =head1 OPTIONS no warnings 'once'; @DB::typeahead = ( 'l 1-200', - 'b 146', + 'b t/30break.pl:146', 'c', '$main::Caught = $main::Value', 'c', diff --git a/t/31break.pl b/t/31break.pl index 88ea468..b0de921 100644 --- a/t/31break.pl +++ b/t/31break.pl @@ -83,7 +83,7 @@ =head1 OPTIONS no warnings 'once'; @DB::typeahead = ( 'l 1-200', - 'b sub_d', + 'b main::sub_d', 'c', '$main::Caught = $main::Value', 'c',