Fix [perl #31971] local $^D gives noise

p4raw-id: //depot/perl@23365

diff --git a/embed.fnc b/embed.fnc
index a847b95..4b9a4a6 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1390,7 +1390,7 @@ sd        |void   |cv_dump        |CV *cv|char *title
 pd     |CV*    |find_runcv     |U32 *db_seqp
 p      |void   |free_tied_hv_pool
 #if defined(DEBUGGING)
-p      |int    |get_debug_opts |char **s
+p      |int    |get_debug_opts |char **s|bool givehelp
 #endif
 Ap     |void   |save_set_svflags|SV* sv|U32 mask|U32 val
 Apod   |void   |hv_assert      |HV* tb

diff --git a/embed.h b/embed.h
index ffa67c1..d082754 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -4748,7 +4748,7 @@
 #endif
 #if defined(DEBUGGING)
 #ifdef PERL_CORE
-#define get_debug_opts(a)      Perl_get_debug_opts(aTHX_ a)
+#define get_debug_opts(a,b)    Perl_get_debug_opts(aTHX_ a,b)
 #endif
 #endif
 #define save_set_svflags(a,b,c)        Perl_save_set_svflags(aTHX_ a,b,c)

diff --git a/mg.c b/mg.c
index e5eedc5..d8e17dd 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2071,7 +2071,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '\004':       /* ^D */
 #ifdef DEBUGGING
        s = SvPV_nolen(sv);
-       PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
+       PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
        DEBUG_x(dump_all());
 #else
        PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;

diff --git a/perl.c b/perl.c
index 70e1bd0..5321758 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2373,7 +2373,7 @@ NULL
 
 #ifdef DEBUGGING
 int
-Perl_get_debug_opts(pTHX_ char **s)
+Perl_get_debug_opts(pTHX_ char **s, bool givehelp)
 {
     static char *usage_msgd[] = {
       " Debugging flag values: (see also -d)",
@@ -2420,7 +2420,7 @@ Perl_get_debug_opts(pTHX_ char **s)
        i = atoi(*s);
        for (; isALNUM(**s); (*s)++) ;
     }
-    else {
+    else if (givehelp) {
       char **p = usage_msgd;
       while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
     }
@@ -2534,7 +2534,7 @@ Perl_moreswitches(pTHX_ char *s)
 #ifdef DEBUGGING
        forbid_setid("-D");
        s++;
-       PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
+       PL_debug = get_debug_opts(&s, 1) | DEBUG_TOP_FLAG;
 #else /* !DEBUGGING */
        if (ckWARN_d(WARN_DEBUGGING))
            Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),

diff --git a/proto.h b/proto.h
index c118c0f..bd14810 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1329,7 +1329,7 @@ STATIC void       S_cv_dump(pTHX_ CV *cv, char *title);
 PERL_CALLCONV CV*      Perl_find_runcv(pTHX_ U32 *db_seqp);
 PERL_CALLCONV void     Perl_free_tied_hv_pool(pTHX);
 #if defined(DEBUGGING)
-PERL_CALLCONV int      Perl_get_debug_opts(pTHX_ char **s);
+PERL_CALLCONV int      Perl_get_debug_opts(pTHX_ char **s, bool givehelp);
 #endif
 PERL_CALLCONV void     Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val);
 PERL_CALLCONV void     Perl_hv_assert(pTHX_ HV* tb);