From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 2 Dec 2008 14:46:17 +0000 (+0000)
Subject: Add two more flags, PERLDBf_SAVESRC_NOSUBS and PERLDBf_SAVESRC_INVALID,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c30d8139ead4f83c6b3d27b2eace9ff0466eaf4c;p=p5sagit%2Fp5-mst-13.2.git

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.

p4raw-id: //depot/perl@34979
---

diff --git a/perl.h b/perl.h
index d08a4a6..3a63261 100644
--- a/perl.h
+++ b/perl.h
@@ -5346,6 +5346,8 @@ 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 */
+#define PERLDBf_SAVESRC_INVALID	0x1000	/* Save source that did not compile */
 
 #define PERLDB_SUB	(PL_perldb && (PL_perldb & PERLDBf_SUB))
 #define PERLDB_LINE	(PL_perldb && (PL_perldb & PERLDBf_LINE))
@@ -5359,6 +5361,8 @@ typedef struct am_table_short AMTS;
 #define PERLDB_NAMEANON	(PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
 #define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION))
 #define PERLDB_SAVESRC 	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
+#define PERLDB_SAVESRC_NOSUBS	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
+#define PERLDB_SAVESRC_INVALID	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
 
 #ifdef USE_LOCALE_NUMERIC
 
diff --git a/pp_ctl.c b/pp_ctl.c
index c8d5a3e..a3b0b0f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3730,9 +3730,10 @@ PP(pp_entereval)
 	save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     PUTBACK;
     ok = doeval(gimme, NULL, runcv, seq);
-    if ((PERLDB_LINE || PERLDB_SAVESRC)
-	&& was != PL_breakable_sub_gen /* Some subs defined here. */
-	&& ok) {
+    if (ok ? (was != PL_breakable_sub_gen /* Some subs defined here. */
+	      ? (PERLDB_LINE || PERLDB_SAVESRC)
+	      :  PERLDB_SAVESRC_NOSUBS)
+	: PERLDB_SAVESRC_INVALID) {
 	/* Just need to change the string in our writable scratch buffer that
 	   will be used at scope exit to delete this eval's "file" name, to
 	   something safe. The key names are of the form "_<(eval 1)" upwards,