Add two more flags, PERLDBf_SAVESRC_NOSUBS and PERLDBf_SAVESRC_INVALID,
authorNicholas Clark <nick@ccl4.org>
Tue, 2 Dec 2008 14:46:17 +0000 (14:46 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 2 Dec 2008 14:46:17 +0000 (14:46 +0000)
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

perl.h
pp_ctl.c

diff --git a/perl.h b/perl.h
index d08a4a6..3a63261 100644 (file)
--- 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
 
index c8d5a3e..a3b0b0f 100644 (file)
--- 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,