diff options
| -rw-r--r-- | intrpvar.h | 2 | ||||
| -rw-r--r-- | locale.c | 9 | ||||
| -rw-r--r-- | perl.h | 14 | ||||
| -rw-r--r-- | t/porting/customized.dat | 2 | ||||
| -rw-r--r-- | vutil.c | 2 |
5 files changed, 23 insertions, 6 deletions
diff --git a/intrpvar.h b/intrpvar.h index 17b2551773..3e7d4a36f7 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -565,7 +565,7 @@ PERLVARI(I, perl_destruct_level, signed char, 0) #ifdef USE_LOCALE_NUMERIC -PERLVARI(I, numeric_standard, bool, TRUE) +PERLVARI(I, numeric_standard, int, TRUE) /* Assume simple numerics */ PERLVARI(I, numeric_local, bool, TRUE) /* Assume local numerics */ @@ -148,9 +148,12 @@ Perl_new_numeric(pTHX_ const char *newnum) * This sets several interpreter-level variables: * PL_numeric_name The default locale's name: a copy of 'newnum' * PL_numeric_local A boolean indicating if the toggled state is such - * that the current locale is the default locale - * PL_numeric_standard A boolean indicating if the toggled state is such - * that the current locale is the C locale + * that the current locale is the program's underlying + * locale + * PL_numeric_standard An int indicating if the toggled state is such + * that the current locale is the C locale. If non-zero, + * it is in C; if > 1, it means it may not be toggled away + * from C. * Note that both of the last two variables can be true at the same time, * if the underlying locale is C. (Toggling is a no-op under these * circumstances.) @@ -5336,7 +5336,10 @@ typedef struct am_table_short AMTS; * these were called */ #define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard) -#define _NOT_IN_NUMERIC_LOCAL (! PL_numeric_local) + +/* We can lock the category to stay in the C locale, making requests to the + * contrary noops, in the dynamic scope by setting PL_numeric_standard to 2 */ +#define _NOT_IN_NUMERIC_LOCAL (! PL_numeric_local && PL_numeric_standard < 2) #define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL; @@ -5393,6 +5396,15 @@ typedef struct am_table_short AMTS; bool _was_standard = _NOT_IN_NUMERIC_LOCAL; \ if (_was_standard) set_numeric_local(); +/* Lock to the C locale until unlock is called */ +#define LOCK_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard) \ + PL_numeric_standard = 2) + +#define UNLOCK_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard == 2) \ + PL_numeric_standard = 1) + #define RESTORE_NUMERIC_LOCAL() \ if (_was_local) set_numeric_local(); diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 4fd3728636..e7b8518c6d 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -16,5 +16,5 @@ autodie cpan/autodie/t/utf8_open.t 5295851351c49f939008c5aca6a798742b1e503d podlators cpan/podlators/scripts/pod2man.PL f81acf53f3ff46cdcc5ebdd661c5d13eb35d20d6 podlators cpan/podlators/scripts/pod2text.PL b4693fcfe4a0a1b38a215cfb8985a65d5d025d69 version cpan/version/lib/version.pm fa9931d4db05aff9a0a6ef558610b1a472d9306e -version vutil.c 238196173eb90dea388443213a4b968323474874 +version vutil.c 0d8c72b682eb8a5582d5c50ad4d821ef01e368c1 version vxs.inc 9064aacbdfe42bb584a068f62b505dd11dbb4dc4 @@ -590,6 +590,7 @@ VER_NV: SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0; char *buf; STORE_NUMERIC_LOCAL_SET_STANDARD(); + LOCK_NUMERIC_STANDARD(); if (sv) { Perl_sv_catpvf(aTHX_ sv, "%.9"NVff, SvNVX(ver)); len = SvCUR(sv); @@ -599,6 +600,7 @@ VER_NV: len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff, SvNVX(ver)); buf = tbuf; } + UNLOCK_NUMERIC_STANDARD(); RESTORE_NUMERIC_LOCAL(); while (buf[len-1] == '0' && len > 0) len--; if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */ |