From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 17 Nov 2008 22:04:56 +0000 (+0000)
Subject: Fix the bug introduced with MRO, whereby the internals were not saving
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aac018bb00282d5a72a5c5b4d95935b9eb667bcc;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
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");
+    }
+}