From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Thu, 14 Oct 2004 14:58:21 +0000 (+0000)
Subject: Fix [perl #31971] local $^D gives noise
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ddcf8bc1d288a9d34b94e354ef9f98b84591150c;p=p5sagit%2Fp5-mst-13.2.git

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

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

diff --git a/embed.fnc b/embed.fnc
index a847b95..4b9a4a6 100644
--- 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
--- 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
--- 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
--- 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
--- 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);