The numeric locale was reset to "C" by s?printf and never restored.

Subject: [ID 20000809.003] setlocale(LC_NUMERIC...) produces different results in 5.005 and 5.6
Message-Id: <20000809170517.A25389@held>

No test since adding the failing example to locale.t
does not fail -- probably because the locale settings are so
thoroughly tweaked by that time.  Running the example standalone
does fail, though.  UPDATE: test case added at change #7540.

p4raw-link: @7540 (not found)

p4raw-id: //depot/perl@6648

5 files changed, 37 insertions, 15 deletions

diff --git a/dump.c b/dump.c
index 1570a91ce0..d0190f58f8 100644
--- a/dump.c
+++ b/dump.c
@@ -279,9 +279,12 @@ Perl_sv_peek(pTHX_ SV *sv)
 	}
     }
     else if (SvNOKp(sv)) {
- 	RESTORE_NUMERIC_STANDARD();
+ 	bool was_local = PL_numeric_local;
+	if (!was_local)
+	    SET_NUMERIC_STANDARD();
 	Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv));
- 	RESTORE_NUMERIC_LOCAL();
+	if (was_local)
+	    SET_NUMERIC_LOCAL();
     }
     else if (SvIOKp(sv)) {
 	if (SvIsUV(sv))
@@ -929,14 +932,17 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	PerlIO_putc(file, '\n');
     }
     if (type >= SVt_PVNV || type == SVt_NV) {
-	RESTORE_NUMERIC_STANDARD();
+	bool was_local = PL_numeric_local;
+	if (!was_local)
+	    SET_NUMERIC_STANDARD();
 	/* %Vg doesn't work? --jhi */
 #ifdef USE_LONG_DOUBLE
 	Perl_dump_indent(aTHX_ level, file, "  NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
 #else
 	Perl_dump_indent(aTHX_ level, file, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
 #endif
-	RESTORE_NUMERIC_LOCAL();
+	if (was_local)
+	    SET_NUMERIC_LOCAL();
     }
     if (SvROK(sv)) {
 	Perl_dump_indent(aTHX_ level, file, "  RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
diff --git a/perl.h b/perl.h
index 1ab2d82769..e5fa9882e4 100644
--- a/perl.h
+++ b/perl.h
@@ -3096,8 +3096,20 @@ typedef struct am_table_short AMTS;
 	((PL_hints & HINT_LOCALE) && \
 	  PL_numeric_radix && (c) == PL_numeric_radix)
 
-#define RESTORE_NUMERIC_LOCAL()		if ((PL_hints & HINT_LOCALE) && PL_numeric_standard) SET_NUMERIC_LOCAL()
-#define RESTORE_NUMERIC_STANDARD()	if ((PL_hints & HINT_LOCALE) && PL_numeric_local) SET_NUMERIC_STANDARD()
+#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
+	bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \
+	if (!was_local) SET_NUMERIC_STANDARD();
+
+#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
+	bool was_standard = !(PL_hints & HINT_LOCALE) || PL_numeric_standard; \
+	if (!was_standard) SET_NUMERIC_LOCAL();
+
+#define RESTORE_NUMERIC_LOCAL() \
+	if (was_local) SET_NUMERIC_LOCAL();
+
+#define RESTORE_NUMERIC_STANDARD() \
+	if (was_standard) SET_NUMERIC_STANDARD();
+
 #define Atof				my_atof
 
 #else /* !USE_LOCALE_NUMERIC */
@@ -3105,6 +3117,8 @@ typedef struct am_table_short AMTS;
 #define SET_NUMERIC_STANDARD()  	/**/
 #define SET_NUMERIC_LOCAL()     	/**/
 #define IS_NUMERIC_RADIX(c)		(0)
+#define STORE_NUMERIC_LOCAL_SET_STANDARD()	/**/
+#define STORE_NUMERIC_STANDARD_SET_LOCAL()	/**/
 #define RESTORE_NUMERIC_LOCAL()		/**/
 #define RESTORE_NUMERIC_STANDARD()	/**/
 #define Atof				Perl_atof
diff --git a/pp.c b/pp.c
index 5371f31d80..d5d5dd88b0 100644
--- a/pp.c
+++ b/pp.c
@@ -1820,7 +1820,7 @@ PP(pp_log)
       NV value;
       value = POPn;
       if (value <= 0.0) {
-	RESTORE_NUMERIC_STANDARD();
+	SET_NUMERIC_STANDARD();
 	DIE(aTHX_ "Can't take log of %g", value);
       }
       value = Perl_log(value);
@@ -1836,7 +1836,7 @@ PP(pp_sqrt)
       NV value;
       value = POPn;
       if (value < 0.0) {
-	RESTORE_NUMERIC_STANDARD();
+	SET_NUMERIC_STANDARD();
 	DIE(aTHX_ "Can't take sqrt of %g", value);
       }
       value = Perl_sqrt(value);
diff --git a/pp_ctl.c b/pp_ctl.c
index 06b29ecab0..45f9a7e2a3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -598,7 +598,7 @@ PP(pp_formline)
 	    value = SvNV(sv);
 	    /* Formats aren't yet marked for locales, so assume "yes". */
 	    {
-		RESTORE_NUMERIC_LOCAL();
+		STORE_NUMERIC_STANDARD_SET_LOCAL();
 #if defined(USE_LONG_DOUBLE)
 		if (arg & 256) {
 		    sprintf(t, "%#*.*" PERL_PRIfldbl,
diff --git a/sv.c b/sv.c
index 80d94b53b0..73704b78ee 100644
--- a/sv.c
+++ b/sv.c
@@ -1803,7 +1803,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	    sv_upgrade(sv, SVt_NV);
 #if defined(USE_LONG_DOUBLE)
 	DEBUG_c({
-	    RESTORE_NUMERIC_STANDARD();
+	    STORE_NUMERIC_LOCAL_SET_STANDARD();
 	    PerlIO_printf(Perl_debug_log,
 			  "0x%"UVxf" num(%" PERL_PRIgldbl ")\n",
 			  PTR2UV(sv), SvNVX(sv));
@@ -1811,7 +1811,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	});
 #else
 	DEBUG_c({
-	    RESTORE_NUMERIC_STANDARD();
+	    STORE_NUMERIC_LOCAL_SET_STANDARD();
 	    PerlIO_printf(Perl_debug_log, "0x%"UVxf" num(%g)\n",
 			  PTR2UV(sv), SvNVX(sv));
 	    RESTORE_NUMERIC_LOCAL();
@@ -1843,14 +1843,14 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     SvNOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
     DEBUG_c({
-	RESTORE_NUMERIC_STANDARD();
+	STORE_NUMERIC_LOCAL_SET_STANDARD();
 	PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n",
 		      PTR2UV(sv), SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
     });
 #else
     DEBUG_c({
-	RESTORE_NUMERIC_STANDARD();
+	STORE_NUMERIC_LOCAL_SET_STANDARD();
 	PerlIO_printf(Perl_debug_log, "0x%"UVxf" 1nv(%g)\n",
 		      PTR2UV(sv), SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
@@ -6555,9 +6555,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    *--eptr = '%';
 
 	    {
-		RESTORE_NUMERIC_STANDARD();
+		STORE_NUMERIC_STANDARD_SET_LOCAL();
+		if (!was_standard && maybe_tainted)
+		    *maybe_tainted = TRUE;
 		(void)sprintf(PL_efloatbuf, eptr, nv);
-		RESTORE_NUMERIC_LOCAL();
+		RESTORE_NUMERIC_STANDARD();
 	    }
 	    eptr = PL_efloatbuf;
 	    elen = strlen(PL_efloatbuf);