Integrate:

[ 34989]
Integrate:
[ 34979]
Add two more flags, PERLDBf_SAVESRC_NOSUBS and PERLDBf_SAVESRC_INVALID,
which give total control over when source code from evals is stored.
The debugger doesn't need them, but I forsee that profilers might.

[ 34981]
Followup to change 34979. Tests are good, m'kay. Particularly when they
show you that something you thought worked doesn't.
Sadly it's not possible to trivially make it work, so for now they're
todo_skip().
p4raw-link: @34989 on //depot/maint-5.10/perl: 1ecb52c42f0d134604a3fc3e9e9391a7336e6b82
p4raw-link: @34981 on //depot/perl: 83fca67e98dfae0d928a42dd87ba57ec05eeb359
p4raw-link: @34979 on //depot/perl: c30d8139ead4f83c6b3d27b2eace9ff0466eaf4c

p4raw-id: //depot/maint-5.8/perl@35035
p4raw-integrated: from //depot/maint-5.10/perl@35033 'edit in' pp_ctl.c
	(@34900..)
p4raw-integrated: from //depot/maint-5.10/perl@34989 'merge in' perl.h
	(@34715..)

2 files changed, 21 insertions, 3 deletions

diff --git a/perl.h b/perl.h
index d4d8626c24..67f2179dac 100644
--- a/perl.h
+++ b/perl.h
@@ -5123,6 +5123,10 @@ typedef struct am_table_short AMTS;
 #define PERLDBf_NAMEEVAL	0x100	/* Informative names for evals */
 #define PERLDBf_NAMEANON	0x200	/* Informative names for anon subs */
 #define PERLDBf_SAVESRC  	0x400	/* Save source lines into @{"_<$filename"} */
+#define PERLDBf_SAVESRC_NOSUBS	0x800	/* Including evals that generate no subrouties */
+#if 0 /* Not yet working. */
+#define PERLDBf_SAVESRC_INVALID	0x1000	/* Save source that did not compile */
+#endif
 
 #define PERLDB_SUB	(PL_perldb && (PL_perldb & PERLDBf_SUB))
 #define PERLDB_LINE	(PL_perldb && (PL_perldb & PERLDBf_LINE))
@@ -5136,6 +5140,10 @@ typedef struct am_table_short AMTS;
 #define PERLDB_NAMEANON	(PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
 
 #define PERLDB_SAVESRC 	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
+#define PERLDB_SAVESRC_NOSUBS	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
+#if 0 /* Not yet working. */
+#define PERLDB_SAVESRC_INVALID	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
+#endif
 
 #ifdef USE_LOCALE_NUMERIC
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 1f4abaf4e3..69466eea25 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3549,9 +3549,19 @@ PP(pp_entereval)
     MUTEX_UNLOCK(&PL_eval_mutex);
 #endif /* USE_5005THREADS */
     ok = doeval(gimme, NULL, runcv, seq);
-    if ((PERLDB_LINE || PERLDB_SAVESRC)
-	&& was != (I32)PL_sub_generation /* Some subs defined here. */
-	&& ok) {
+    if (ok ? (was != (I32)PL_sub_generation /* Some subs defined here. */
+	      ? (PERLDB_LINE || PERLDB_SAVESRC)
+	      :  PERLDB_SAVESRC_NOSUBS)
+	: 0 /* PERLDB_SAVESRC_INVALID */
+	/* Much that I'd like to think that it was this trivial to add this
+	   feature, it's not, due to
+	       lex_end();
+	       LEAVE;
+	   in S_doeval() for the failure case. So really we want a more
+	   sophisticated way of (optionally) clearing the source code.
+	   Particularly as the current way is buggy, as a syntactically
+	   invalid eval string can still define a subroutine that is retained,
+	   and the user may wish to breakpoint. */) {
 	/* Copy in anything fake and short. */
 	my_strlcpy(safestr, fakestr, fakelen);
     }