This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Refactor static fcn to save work
authorKarl Williamson <khw@cpan.org>
Thu, 20 Jul 2017 22:20:01 +0000 (16:20 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 9 Nov 2017 02:50:29 +0000 (19:50 -0700)
This adds a parameter to the function that sets the radix character for
floating point numbers.  We know that the radix by default is a dot, so
no need to calculate it in that case.

This code was previously using localeconv() to find the locale's decimal
point.  The just added my_nl_langinfo() fcn does the same with an easier
API, and is more thread safe, and automatically switches to use
localeconv() when n nl_langinfo() isn't available, so revise the
conditional compilation directives that previously were necessary, and
collapse directives that were unnecessarily nested.

And adjust indentation

embed.fnc
embed.h
locale.c
proto.h

index bdde5ea..0212d02 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2736,7 +2736,7 @@ in        |const char *|save_to_buffer|NN const char * string     \
 s      |char*  |stdize_locale  |NN char* locs
 s      |void   |new_collate    |NULLOK const char* newcoll
 s      |void   |new_ctype      |NN const char* newctype
-s      |void   |set_numeric_radix
+s      |void   |set_numeric_radix|const bool use_locale
 #    ifdef WIN32
 s      |char*  |my_setlocale   |int category|NULLOK const char* locale
 #    endif
diff --git a/embed.h b/embed.h
index ed7d5af..fcaa235 100644 (file)
--- a/embed.h
+++ b/embed.h
 #    if defined(USE_LOCALE)
 #define new_collate(a)         S_new_collate(aTHX_ a)
 #define new_ctype(a)           S_new_ctype(aTHX_ a)
-#define set_numeric_radix()    S_set_numeric_radix(aTHX)
+#define set_numeric_radix(a)   S_set_numeric_radix(aTHX_ a)
 #define stdize_locale(a)       S_stdize_locale(aTHX_ a)
 #      if defined(WIN32)
 #define my_setlocale(a,b)      S_my_setlocale(aTHX_ a,b)
index 2e0fdc2..46b0ec6 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -103,35 +103,46 @@ S_stdize_locale(pTHX_ char *locs)
 #endif
 
 STATIC void
-S_set_numeric_radix(pTHX)
+S_set_numeric_radix(pTHX_ const bool use_locale)
 {
+    /* If 'use_locale' is FALSE, set to use a dot for the radix character.  If
+     * TRUE, use the radix character derived from the current locale */
 
-#ifdef USE_LOCALE_NUMERIC
-#  ifdef HAS_LOCALECONV
-    const struct lconv* const lc = localeconv();
+#if defined(USE_LOCALE_NUMERIC) && (   defined(HAS_LOCALECONV)              \
+                                    || defined(HAS_NL_LANGINFO))
 
-    if (lc && lc->decimal_point) {
-       if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
-           SvREFCNT_dec(PL_numeric_radix_sv);
-           PL_numeric_radix_sv = NULL;
-       }
-       else {
-           if (PL_numeric_radix_sv)
-               sv_setpv(PL_numeric_radix_sv, lc->decimal_point);
-           else
-               PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0);
-            if (! is_utf8_invariant_string((U8 *) lc->decimal_point, 0)
-                && is_utf8_string((U8 *) lc->decimal_point, 0)
+    /* We only set up the radix SV if we are to use a locale radix ... */
+    if (use_locale) {
+        const char * radix = my_nl_langinfo(PERL_RADIXCHAR, FALSE);
+                                          /* FALSE => already in dest locale */
+
+        /* ... and the character being used isn't a dot */
+        if (strNE(radix, ".")) {
+            if (PL_numeric_radix_sv) {
+                sv_setpv(PL_numeric_radix_sv, radix);
+            }
+            else {
+                PL_numeric_radix_sv = newSVpv(radix, 0);
+            }
+
+            if ( !  is_utf8_invariant_string(
+                     (U8 *) SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))
+                &&  is_utf8_string(
+                     (U8 *) SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))
                 && _is_cur_LC_category_utf8(LC_NUMERIC))
             {
-               SvUTF8_on(PL_numeric_radix_sv);
+                SvUTF8_on(PL_numeric_radix_sv);
             }
-       }
+            goto done;
+        }
     }
-    else
-       PL_numeric_radix_sv = NULL;
 
-#    ifdef DEBUGGING
+    SvREFCNT_dec(PL_numeric_radix_sv);
+    PL_numeric_radix_sv = NULL;
+
+  done: ;
+
+#  ifdef DEBUGGING
 
     if (DEBUG_L_TEST || debug_initialization) {
         PerlIO_printf(Perl_debug_log, "Locale radix is '%s', ?UTF-8=%d\n",
@@ -143,9 +154,8 @@ S_set_numeric_radix(pTHX)
                                            : 0);
     }
 
-#    endif
-#  endif /* HAS_LOCALECONV */
-#endif /* USE_LOCALE_NUMERIC */
+#  endif
+#endif /* USE_LOCALE_NUMERIC and can find the radix char */
 
 }
 
@@ -252,7 +262,7 @@ Perl_set_numeric_standard(pTHX)
     setlocale(LC_NUMERIC, "C");
     PL_numeric_standard = TRUE;
     PL_numeric_local = isNAME_C_OR_POSIX(PL_numeric_name);
-    set_numeric_radix();
+    set_numeric_radix(0);
 
 #  ifdef DEBUGGING
 
@@ -281,7 +291,7 @@ Perl_set_numeric_local(pTHX)
     setlocale(LC_NUMERIC, PL_numeric_name);
     PL_numeric_standard = isNAME_C_OR_POSIX(PL_numeric_name);
     PL_numeric_local = TRUE;
-    set_numeric_radix();
+    set_numeric_radix(1);
 
 #  ifdef DEBUGGING
 
diff --git a/proto.h b/proto.h
index 939ba28..1a83a36 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4633,7 +4633,7 @@ STATIC void       S_new_collate(pTHX_ const char* newcoll);
 STATIC void    S_new_ctype(pTHX_ const char* newctype);
 #define PERL_ARGS_ASSERT_NEW_CTYPE     \
        assert(newctype)
-STATIC void    S_set_numeric_radix(pTHX);
+STATIC void    S_set_numeric_radix(pTHX_ const bool use_locale);
 STATIC char*   S_stdize_locale(pTHX_ char* locs);
 #define PERL_ARGS_ASSERT_STDIZE_LOCALE \
        assert(locs)