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 (file)
--- 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 (file)
--- 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 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -1449,6 +1449,11 @@ in case 6.
 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

diff --git a/pod/perlintern.pod b/pod/perlintern.pod
index c2e246a..0d0b19d 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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++;
+}