Fix the bug introduced with MRO, whereby the internals were not saving

lines in subroutines defined inside eval ""s for the debugger.

p4raw-id: //depot/perl@34873

diff --git a/MANIFEST b/MANIFEST
index 5ddeec6..f4d7106 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3679,6 +3679,7 @@ t/comp/parser.t                   See if the parser works in edge cases
 t/comp/proto.t                 See if function prototypes work
 t/comp/redef.t                 See if we get correct warnings on redefined subs
 t/comp/require.t               See if require works
+t/comp/retainedlines.t         See if the debugger can retains eval's lines
 t/comp/script.t                        See if script invocation works
 t/comp/term.t                  See if more terms work
 t/comp/uproto.t                        See if the _ prototype works

diff --git a/embedvar.h b/embedvar.h
index 6ea599f..9b05dd6 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -75,6 +75,7 @@
 #define PL_body_arenas         (vTHX->Ibody_arenas)
 #define PL_body_roots          (vTHX->Ibody_roots)
 #define PL_bodytarget          (vTHX->Ibodytarget)
+#define PL_breakable_sub_generation    (vTHX->Ibreakable_sub_generation)
 #define PL_checkav             (vTHX->Icheckav)
 #define PL_checkav_save                (vTHX->Icheckav_save)
 #define PL_chopset             (vTHX->Ichopset)
@@ -387,6 +388,7 @@
 #define PL_Ibody_arenas                PL_body_arenas
 #define PL_Ibody_roots         PL_body_roots
 #define PL_Ibodytarget         PL_bodytarget
+#define PL_Ibreakable_sub_generation   PL_breakable_sub_generation
 #define PL_Icheckav            PL_checkav
 #define PL_Icheckav_save       PL_checkav_save
 #define PL_Ichopset            PL_chopset

diff --git a/intrpvar.h b/intrpvar.h
index e5c9e3b..ac50f84 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -677,6 +677,8 @@ PERLVARI(Idestroyhook, destroyable_proc_t, MEMBER_TO_FPTR(Perl_sv_destroyable))
 PERLVARI(Isv_serial, U32, 0) /* SV serial number, used in sv.c */
 #endif
 
+PERLVARI(Ibreakable_sub_generation, U32, 0)
+
 /* If you are adding a U8 or U16, check to see if there are 'Space' comments
  * above on where there are gaps which currently will be structure padding.  */
 

diff --git a/op.c b/op.c
index 1200422..11e940b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5797,6 +5797,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (!block)
        goto done;
 
+    /* If we assign an optree to a PVCV, then we've defined a subroutine that
+       the debugger could be able to set a breakpoint in, so signal to
+       pp_entereval that it should not throw away any saved lines at scope
+       exit.  */
+       
+    PL_breakable_sub_generation++;
     if (CvLVALUE(cv)) {
        CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
                             mod(scalarseq(block), OP_LEAVESUBLV));

diff --git a/perlapi.h b/perlapi.h
index b913b53..ce540c8 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -186,6 +186,8 @@ END_EXTERN_C
 #define PL_body_roots          (*Perl_Ibody_roots_ptr(aTHX))
 #undef  PL_bodytarget
 #define PL_bodytarget          (*Perl_Ibodytarget_ptr(aTHX))
+#undef  PL_breakable_sub_generation
+#define PL_breakable_sub_generation    (*Perl_Ibreakable_sub_generation_ptr(aTHX))
 #undef  PL_checkav
 #define PL_checkav             (*Perl_Icheckav_ptr(aTHX))
 #undef  PL_checkav_save

diff --git a/pp_ctl.c b/pp_ctl.c
index 268bb35..b2cbbde 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3653,7 +3653,7 @@ PP(pp_entereval)
     register PERL_CONTEXT *cx;
     SV *sv;
     const I32 gimme = GIMME_V;
-    const I32 was = PL_sub_generation;
+    const I32 was = PL_breakable_sub_generation;
     char tbuf[TYPE_DIGITS(long) + 12];
     char *tmpbuf = tbuf;
     char *safestr;

diff --git a/t/comp/retainedlines.t b/t/comp/retainedlines.t
new file mode 100644 (file)
index 0000000..2148fc5
--- /dev/null
+++ b/t/comp/retainedlines.t
@@ -0,0 +1,43 @@
+#!./perl -w
+
+# Check that lines from eval are correctly retained by the debugger
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "./test.pl";
+}
+
+use strict;
+
+plan( tests => 10 );
+
+my @before = grep { /eval/ } keys %::;
+
+is (@before, 0, "No evals");
+
+for my $sep (' ') {
+    $^P = 0xA;
+
+    my $prog = "sub foo {
+    'Perl${sep}Rules'
+};
+1;
+";
+
+    eval $prog or die;
+    # Is there a more efficient way to write this?
+    my @expect_lines = (undef, map ({"$_\n"} split "\n", $prog), "\n", ';');
+
+    my @keys = grep { /eval/ } keys %::;
+
+    is (@keys, 1, "1 eval");
+
+    my @got_lines = @{$::{$keys[0]}};
+
+    is (@got_lines, @expect_lines, "Right number of lines for " . ord $sep);
+
+    for (0..$#expect_lines) {
+       is ($got_lines[$_], $expect_lines[$_], "Line $_ is correct");
+    }
+}