From 43e4250a611bbded7aab070226e8d756638cd569 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Mon, 28 Oct 2013 16:14:35 -0700 Subject: [PATCH] [perl #119799] Set breakpoints without *DB::dbline MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit The elements of the %{"_<..."} hashes (where ‘...’ is the filename), whose keys are line numbers, are used to set breakpoints on the given lines. The corresponding @{"_<..."} array contains the actual lines of source code. %{"_<..."} actually acts on the array of lines that @DB::dbline is aliased to. The assumption is that *DB::dbline = *{"_<..."} will have taken place first. Hence, all %{"_<..."} hashes are the same, when it comes to writing to keys. It is more useful for each %{"_<..."} hash to set breakpoints on its corresponding file’s lines regardless of whether @DB::dbline has been aliased, so that is what this commit does. Each hash’s mg_obj pointer in its dbfile magic now points to the array, and magic_setdbline uses it instead of PL_DBline. --- gv.c | 2 +- mg.c | 3 ++- t/run/switchd.t | 23 ++++++++++++++++++++++- 3 files changed, 25 insertions(+), 3 deletions(-) diff --git a/gv.c b/gv.c index c745315..e7ef9a7 100644 --- a/gv.c +++ b/gv.c @@ -132,7 +132,7 @@ Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen, #endif } if ((PERLDB_LINE || PERLDB_SAVESRC) && !GvAV(gv)) - hv_magic(GvHVn(gv_AVadd(gv)), NULL, PERL_MAGIC_dbfile); + hv_magic(GvHVn(gv), GvAVn(gv), PERL_MAGIC_dbfile); if (tmpbuf != smallbuf) Safefree(tmpbuf); return gv; diff --git a/mg.c b/mg.c index f88428a..83aafa4 100644 --- a/mg.c +++ b/mg.c @@ -1974,7 +1974,8 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) /* Use sv_2iv instead of SvIV() as the former generates smaller code, and setting/clearing debugger breakpoints is not a hot path. */ - svp = av_fetch(GvAV(PL_DBline), sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); + svp = av_fetch(MUTABLE_AV(mg->mg_obj), + sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); if (svp && SvIOKp(*svp)) { OP * const o = INT2PTR(OP*,SvIVX(*svp)); diff --git a/t/run/switchd.t b/t/run/switchd.t index 9f3374e..f901bf6 100644 --- 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 => 16); +plan(tests => 17); my $r; @@ -232,3 +232,24 @@ is( "ok\n", "%DB::lsub is not vivified" ); + +# Test setting of breakpoints without *DB::dbline aliased +is( + runperl( + switches => [ '-Ilib', '-d:nodb' ], + progs => [ split "\n", + 'sub DB::DB { + $DB::single = 0, return if $DB::single; print qq[ok\n]; exit + } + ${q(_<).__FILE__}{6} = 1; # set a breakpoint + sub foo { + die; # line 6 + } + foo(); + ' + ], + stderr => 1 + ), + "ok\n", + "setting breakpoints without *DB::dbline aliased" +); -- 2.7.4