This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow dynamic lock of LC_NUMERIC
authorKarl Williamson <khw@cpan.org>
Mon, 2 Jun 2014 02:07:30 +0000 (20:07 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 5 Jun 2014 17:23:00 +0000 (11:23 -0600)
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

intrpvar.h
locale.c
perl.h
t/porting/customized.dat
vutil.c

index 17b2551..3e7d4a3 100644 (file)
@@ -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 */
index 3004dce..929a249 100644 (file)
--- 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 970a25f..3ee2cd4 100644 (file)
--- 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();
 
index 4fd3728..e7b8518 100644 (file)
@@ -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 200ff73..6f92d33 100644 (file)
--- 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 */