Change 18307 by rgs@rgs-home on 2002/12/16 22:01:14 Subject: [PATCH] Re: [perl #19017] lexical "my" variables not visible in debugger "x" command From: Dave Mitchell <[EMAIL PROTECTED]> Date: Thu, 12 Dec 2002 23:42:35 +0000 Message-ID: <[EMAIL PROTECTED]> and Date: Sat, 14 Dec 2002 19:16:38 +0000 Message-ID: <[EMAIL PROTECTED]>
Affected files ... ... //depot/perl/embed.fnc#58 edit ... //depot/perl/embed.h#373 edit ... //depot/perl/pod/perlfunc.pod#361 edit ... //depot/perl/pod/perlintern.pod#27 edit ... //depot/perl/pp_ctl.c#331 edit ... //depot/perl/proto.h#416 edit ... //depot/perl/t/op/eval.t#24 edit Differences ... ==== //depot/perl/embed.fnc#58 (text) ==== Index: perl/embed.fnc --- perl/embed.fnc#57~18302~ Sat Dec 14 14:34:25 2002 +++ perl/embed.fnc Mon Dec 16 14:01:14 2002 @@ -1353,7 +1353,7 @@ # endif s |CV* |cv_clone2 |CV *proto|CV *outside #endif -pd |CV* |find_runcv +pd |CV* |find_runcv |U32 *db_seqp ==== //depot/perl/embed.h#373 (text+w) ==== Index: perl/embed.h --- perl/embed.h#372~18220~ Sun Dec 1 16:58:54 2002 +++ perl/embed.h Mon Dec 16 14:01:14 2002 @@ -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) ==== //depot/perl/pod/perlfunc.pod#361 (text) ==== Index: perl/pod/perlfunc.pod --- perl/pod/perlfunc.pod#360~18115~ Wed Nov 6 12:43:14 2002 +++ perl/pod/perlfunc.pod Mon Dec 16 14:01:14 2002 @@ -1449,6 +1449,11 @@ C<eval BLOCK> does I<not> count as a loop, so the loop control statements C<next>, C<last>, or C<redo> cannot be used to leave or restart the block. +Note that as a very special case, an C<eval ''> executed within the C<DB> +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 ==== //depot/perl/pod/perlintern.pod#27 (text+w) ==== Index: perl/pod/perlintern.pod --- perl/pod/perlintern.pod#26~18302~ Sat Dec 14 14:34:25 2002 +++ perl/pod/perlintern.pod Mon Dec 16 14:01:14 2002 @@ -285,8 +285,12 @@ =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 ==== //depot/perl/pp_ctl.c#331 (text) ==== Index: perl/pp_ctl.c --- perl/pp_ctl.c#330~18302~ Sat Dec 14 14:34:25 2002 +++ perl/pp_ctl.c Mon Dec 16 14:01:14 2002 @@ -2615,7 +2615,7 @@ /* 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 @@ =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 @@ STRLEN len; OP *ret; CV* runcv; + U32 seq; if (!SvPV(sv,len)) RETPUSHUNDEF; @@ -3269,7 +3283,12 @@ 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 @@ 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. */ ==== //depot/perl/proto.h#416 (text+w) ==== Index: perl/proto.h --- perl/proto.h#415~18220~ Sun Dec 1 16:58:54 2002 +++ perl/proto.h Mon Dec 16 14:01:14 2002 @@ -1381,7 +1381,7 @@ # 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); ==== //depot/perl/t/op/eval.t#24 (xtext) ==== Index: perl/t/op/eval.t --- perl/t/op/eval.t#23~18222~ Sun Dec 1 18:23:28 2002 +++ perl/t/op/eval.t Mon Dec 16 14:01:14 2002 @@ -1,6 +1,6 @@ #!./perl -print "1..78\n"; +print "1..84\n"; eval 'print "ok 1\n";'; @@ -349,3 +349,29 @@ 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++; +} End of Patch.