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.
