diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | embedvar.h | 2 | ||||
| -rw-r--r-- | intrpvar.h | 2 | ||||
| -rw-r--r-- | op.c | 6 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | t/comp/retainedlines.t | 43 |
7 files changed, 57 insertions, 1 deletions
@@ -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 6ea599f972..9b05dd6362 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 e5c9e3bed1..ac50f84882 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. */ @@ -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)); @@ -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 @@ -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 0000000000..2148fc5254 --- /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"); + } +} |