Allow dynamic lock of LC_NUMERIC

When processing version strings, the radix character must be a dot even
if we otherwise would be using some other character.  vutil.c
upg_version() changes to the dot, but calls sv_catpvf() which may try to
change the character to something else.  This commit introduces a way to
lock the character to a dot around the call to sv_catpvf()

vutil.c is cpan-upstream, but already blead and cpan have diverged, so
this just updates the SHA of the new version

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 */
diff --git a/locale.c b/locale.c
index 3004dce9c9..929a249a81 100644
--- a/locale.c
+++ b/locale.c
@@ -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.)
diff --git a/perl.h b/perl.h
index 970a25ff1a..3ee2cd49af 100644
--- a/perl.h
+++ b/perl.h
@@ -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
diff --git a/vutil.c b/vutil.c
index 200ff73cb6..6f92d33274 100644
--- a/vutil.c
+++ b/vutil.c
@@ -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 */