From: Dave Mitchell Date: Thu, 12 Dec 2002 23:42:35 +0000 (+0000) Subject: Re: [perl #19017] lexical "my" variables not visible in debugger "x" command X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d819b83ae9e817e78735176f8a6e23d7a0957169;p=p5sagit%2Fp5-mst-13.2.git Re: [perl #19017] lexical "my" variables not visible in debugger "x" command Date: Thu, 12 Dec 2002 23:42:35 +0000 Message-ID: <20021212234235.A29245@fdgroup.com> and Date: Sat, 14 Dec 2002 19:16:38 +0000 Message-ID: <20021214191638.A3992@fdgroup.com> p4raw-id: //depot/perl@18307 --- diff --git a/embed.fnc b/embed.fnc index 5c56027..ace2ade 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1353,7 +1353,7 @@ sd |void |cv_dump |CV *cv|char *title # endif s |CV* |cv_clone2 |CV *proto|CV *outside #endif -pd |CV* |find_runcv +pd |CV* |find_runcv |U32 *db_seqp diff --git a/embed.h b/embed.h index 828746e..636dca9 100644 --- a/embed.h +++ b/embed.h @@ -2760,7 +2760,7 @@ # endif #define cv_clone2(a,b) S_cv_clone2(aTHX_ a,b) #endif -#define find_runcv() Perl_find_runcv(aTHX) +#define find_runcv(a) Perl_find_runcv(aTHX_ a) #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 8a745ef..2496f83 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -1449,6 +1449,11 @@ in case 6. C does I count as a loop, so the loop control statements C, C, or C cannot be used to leave or restart the block. +Note that as a very special case, an C executed within the C +package doesn't see the usual surrounding lexical scope, but rather the +scope of the first non-DB piece of code that called it. You don't normally +need to worry about this unless you are writing a Perl debugger. + =item exec LIST =item exec PROGRAM LIST diff --git a/pod/perlintern.pod b/pod/perlintern.pod index c2e246a..0d0b19d 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -285,8 +285,12 @@ Found in file pad.h =item find_runcv Locate the CV corresponding to the currently executing sub or eval. +If db_seqp is non_null, skip CVs that are in the DB package and populate +*db_seqp with the cop sequence number at the point that the DB:: code was +entered. (allows debuggers to eval in the scope of the breakpoint rather +than in in the scope of the debuger itself). - CV* find_runcv() + CV* find_runcv(U32 *db_seqp) =for hackers Found in file pp_ctl.c diff --git a/pp_ctl.c b/pp_ctl.c index 143888d..623b1ce 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2615,7 +2615,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp) /* we get here either during compilation, or via pp_regcomp at runtime */ runtime = PL_op && (PL_op->op_type == OP_REGCOMP); if (runtime) - runcv = find_runcv(); + runcv = find_runcv(NULL); PL_op = &dummy; PL_op->op_type = OP_ENTEREVAL; @@ -2649,22 +2649,35 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp) =for apidoc find_runcv Locate the CV corresponding to the currently executing sub or eval. +If db_seqp is non_null, skip CVs that are in the DB package and populate +*db_seqp with the cop sequence number at the point that the DB:: code was +entered. (allows debuggers to eval in the scope of the breakpoint rather +than in in the scope of the debuger itself). =cut */ CV* -Perl_find_runcv(pTHX) +Perl_find_runcv(pTHX_ U32 *db_seqp) { I32 ix; PERL_SI *si; PERL_CONTEXT *cx; + if (db_seqp) + *db_seqp = PL_curcop->cop_seq; for (si = PL_curstackinfo; si; si = si->si_prev) { for (ix = si->si_cxix; ix >= 0; ix--) { cx = &(si->si_cxstack[ix]); - if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) - return cx->blk_sub.cv; + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { + CV *cv = cx->blk_sub.cv; + /* skip DB:: code */ + if (db_seqp && PL_debstash && CvSTASH(cv) == PL_debstash) { + *db_seqp = cx->blk_oldcop->cop_seq; + continue; + } + return cv; + } else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx)) return PL_compcv; } @@ -3222,6 +3235,7 @@ PP(pp_entereval) STRLEN len; OP *ret; CV* runcv; + U32 seq; if (!SvPV(sv,len)) RETPUSHUNDEF; @@ -3269,7 +3283,12 @@ PP(pp_entereval) PL_compiling.cop_io = newSVsv(PL_curcop->cop_io); SAVEFREESV(PL_compiling.cop_io); } - runcv = find_runcv(); + /* special case: an eval '' executed within the DB package gets lexically + * placed in the first non-DB CV rather than the current CV - this + * allows the debugger to execute code, find lexicals etc, in the + * scope of the code being debugged. Passing &seq gets find_runcv + * to do the dirty work for us */ + runcv = find_runcv(&seq); push_return(PL_op->op_next); PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP); @@ -3280,7 +3299,7 @@ PP(pp_entereval) if (PERLDB_LINE && PL_curstash != PL_debstash) save_lines(CopFILEAV(&PL_compiling), PL_linestr); PUTBACK; - ret = doeval(gimme, NULL, runcv, PL_curcop->cop_seq); + ret = doeval(gimme, NULL, runcv, seq); if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */ && ret != PL_op->op_next) { /* Successive compilation. */ strcpy(safestr, "_<(eval )"); /* Anything fake and short. */ diff --git a/proto.h b/proto.h index b5ade02..fca42ed 100644 --- a/proto.h +++ b/proto.h @@ -1381,7 +1381,7 @@ STATIC void S_cv_dump(pTHX_ CV *cv, char *title); # endif STATIC CV* S_cv_clone2(pTHX_ CV *proto, CV *outside); #endif -PERL_CALLCONV CV* Perl_find_runcv(pTHX); +PERL_CALLCONV CV* Perl_find_runcv(pTHX_ U32 *db_seqp); diff --git a/t/op/eval.t b/t/op/eval.t index 41c5ef3..e81b9f7 100755 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -1,6 +1,6 @@ #!./perl -print "1..78\n"; +print "1..84\n"; eval 'print "ok 1\n";'; @@ -349,3 +349,29 @@ eval q{ my $yyy = 888; my $zzz = 999; fred5(); }; print "ok 78\n"; } +# evals that appear in the DB package should see the lexical scope of the +# thing outside DB that called them (usually the debugged code), rather +# than the usual surrounding scope + +$test=79; +our $x = 1; +{ + my $x=2; + sub db1 { $x; eval '$x' } + sub DB::db2 { $x; eval '$x' } + package DB; + sub db3 { eval '$x' } + sub DB::db4 { eval '$x' } + sub db5 { my $x=4; eval '$x' } + package main; + sub db6 { my $x=4; eval '$x' } +} +{ + my $x = 3; + print db1() == 2 ? 'ok' : 'not ok', " $test\n"; $test++; + print DB::db2() == 2 ? 'ok' : 'not ok', " $test\n"; $test++; + print DB::db3() == 3 ? 'ok' : 'not ok', " $test\n"; $test++; + print DB::db4() == 3 ? 'ok' : 'not ok', " $test\n"; $test++; + print DB::db5() == 3 ? 'ok' : 'not ok', " $test\n"; $test++; + print db6() == 4 ? 'ok' : 'not ok', " $test\n"; $test++; +}