From f93f4e4670f12de7577ebaebeb5e31d4510ff4fe Mon Sep 17 00:00:00 2001 From: Christian Kirsch Date: Wed, 9 Aug 2000 19:05:17 +0200 Subject: [PATCH] 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 --- dump.c | 14 ++++++++++---- perl.h | 18 ++++++++++++++++-- pp.c | 4 ++-- pp_ctl.c | 2 +- sv.c | 14 ++++++++------ 5 files changed, 37 insertions(+), 15 deletions(-) diff --git a/dump.c b/dump.c index 1570a91..d0190f5 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 1ab2d82..e5fa988 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 5371f31..d5d5dd8 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 06b29ec..45f9a7e 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 80d94b5..73704b7 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); -- 2.7.4