Change 34898 by [EMAIL PROTECTED] on 2008/11/21 10:22:59
Integrate:
[ 34873]
Fix the bug introduced with MRO, whereby the internals were not saving
lines in subroutines defined inside eval ""s for the debugger.
[ 34879]
Rafael noticed a bug in 34873 - I was comparing against the wrong
variable, and hence (usually) saving all globs, not just those that
should be kept.
[ 34880]
Use only unsigned ints for comparisons to PL_breakable_sub_generation
[ 34886]
Rename PL_breakable_sub_generation to PL_breakable_sub_gen, to please
the ANSI gods of VMS.
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#54 integrate
... //depot/maint-5.10/perl/embedvar.h#3 integrate
... //depot/maint-5.10/perl/intrpvar.h#4 integrate
... //depot/maint-5.10/perl/op.c#19 integrate
... //depot/maint-5.10/perl/perlapi.h#3 integrate
... //depot/maint-5.10/perl/pp_ctl.c#26 integrate
... //depot/maint-5.10/perl/t/comp/retainedlines.t#1 branch
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#54 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#53~34846~ 2008-11-16 10:29:22.000000000 -0800
+++ perl/MANIFEST 2008-11-21 02:22:59.000000000 -0800
@@ -3538,6 +3538,7 @@
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
==== //depot/maint-5.10/perl/embedvar.h#3 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h#2~34599~ 2008-10-26 14:44:48.000000000 -0700
+++ perl/embedvar.h 2008-11-21 02:22:59.000000000 -0800
@@ -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_gen (vTHX->Ibreakable_sub_gen)
#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_gen PL_breakable_sub_gen
#define PL_Icheckav PL_checkav
#define PL_Icheckav_save PL_checkav_save
#define PL_Ichopset PL_chopset
==== //depot/maint-5.10/perl/intrpvar.h#4 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#3~34599~ 2008-10-26 14:44:48.000000000 -0700
+++ perl/intrpvar.h 2008-11-21 02:22:59.000000000 -0800
@@ -673,6 +673,9 @@
/* Can shared object be destroyed */
PERLVARI(Idestroyhook, destroyable_proc_t, MEMBER_TO_FPTR(Perl_sv_destroyable))
+/* Perl_Ibreakable_sub_generation_ptr was too long for VMS, hence "gen" */
+PERLVARI(Ibreakable_sub_gen, 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. */
==== //depot/maint-5.10/perl/op.c#19 (text) ====
Index: perl/op.c
--- perl/op.c#18~34715~ 2008-11-04 00:28:29.000000000 -0800
+++ perl/op.c 2008-11-21 02:22:59.000000000 -0800
@@ -5583,6 +5583,12 @@
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_gen++;
if (CvLVALUE(cv)) {
CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
mod(scalarseq(block), OP_LEAVESUBLV));
==== //depot/maint-5.10/perl/perlapi.h#3 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h#2~34599~ 2008-10-26 14:44:48.000000000 -0700
+++ perl/perlapi.h 2008-11-21 02:22:59.000000000 -0800
@@ -186,6 +186,8 @@
#define PL_body_roots (*Perl_Ibody_roots_ptr(aTHX))
#undef PL_bodytarget
#define PL_bodytarget (*Perl_Ibodytarget_ptr(aTHX))
+#undef PL_breakable_sub_gen
+#define PL_breakable_sub_gen (*Perl_Ibreakable_sub_gen_ptr(aTHX))
#undef PL_checkav
#define PL_checkav (*Perl_Icheckav_ptr(aTHX))
#undef PL_checkav_save
==== //depot/maint-5.10/perl/pp_ctl.c#26 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#25~34865~ 2008-11-17 03:05:30.000000000 -0800
+++ perl/pp_ctl.c 2008-11-21 02:22:59.000000000 -0800
@@ -3573,7 +3573,7 @@
register PERL_CONTEXT *cx;
SV *sv;
const I32 gimme = GIMME_V;
- const I32 was = PL_sub_generation;
+ const U32 was = PL_breakable_sub_gen;
char tbuf[TYPE_DIGITS(long) + 12];
char *tmpbuf = tbuf;
char *safestr;
@@ -3653,7 +3653,7 @@
PUTBACK;
ok = doeval(gimme, NULL, runcv, seq);
if ((PERLDB_LINE || PERLDB_SAVESRC)
- && was != (I32)PL_sub_generation /* Some subs defined here. */
+ && was != PL_breakable_sub_gen /* Some subs defined here. */
&& ok) {
/* Copy in anything fake and short. */
my_strlcpy(safestr, fakestr, fakelen);
==== //depot/maint-5.10/perl/t/comp/retainedlines.t#1 (text) ====
Index: perl/t/comp/retainedlines.t
--- /dev/null 2008-11-04 07:18:13.288883315 -0800
+++ perl/t/comp/retainedlines.t 2008-11-21 02:22:59.000000000 -0800
@@ -0,0 +1,57 @@
+#!./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 => 21);
+
+$^P = 0xA;
+
+my @before = grep { /eval/ } keys %::;
+
+is (@before, 0, "No evals");
+
+my %seen;
+my $name = 'foo';
+
+for my $sep (' ', "\0") {
+
+ my $prog = "sub $name {
+ '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 {!$seen{$_}} grep { /eval/ } keys %::;
+
+ is (@keys, 1, "1 new 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");
+ }
+ $seen{$keys[0]}++;
+ $name++;
+}
+
+is (eval '1 + 1', 2, 'String eval works');
+
+my @after = grep { /eval/ } keys %::;
+
+is (@after, 0 + keys %seen,
+ "evals that don't define subroutines are correctly cleaned up");
+
End of Patch.
