Fix for the fa_IR locale failure. The reason for the failure

was that Perl was assuming the decimal separator aka the radix
separator is one character.  The Farsi-Iranian locale crushed
that bad assumption since there the separator is 'Momayyez',
glyphwise looking somewhat like a slash, and in Unicode UTF-8
encoded in two bytes, 0xd9 0xab.

p4raw-id: //depot/perl@8625

diff --git a/intrpvar.h b/intrpvar.h
index 8b2aa29..8ecd10f 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -362,8 +362,8 @@ PERLVARI(Inumeric_standard, bool,   TRUE)
                                        /* Assume simple numerics */
 PERLVARI(Inumeric_local,       bool,   TRUE)
                                        /* Assume local numerics */
-PERLVAR(Inumeric_radix,                char)
-                                       /* The radix character if not '.' */
+PERLVAR(Inumeric_radix,                SV *)
+                                       /* The radix separator if not '.' */
 
 #endif /* !USE_LOCALE_NUMERIC */
 

diff --git a/perl.c b/perl.c
index a5f4e68..21ca8aa 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -562,6 +562,7 @@ perl_destruct(pTHXx)
 #ifdef USE_LOCALE_NUMERIC
     Safefree(PL_numeric_name);
     PL_numeric_name = Nullch;
+    SvREFCNT_dec(PL_numeric_radix);
 #endif
 
     /* clear utf8 character classes */

diff --git a/perl.h b/perl.h
index 7441ea5..498e6e3 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3217,9 +3217,9 @@ typedef struct am_table_short AMTS;
 #define SET_NUMERIC_LOCAL() \
        set_numeric_local();
 
-#define IS_NUMERIC_RADIX(c)    \
+#define IS_NUMERIC_RADIX(s)    \
        ((PL_hints & HINT_LOCALE) && \
-         PL_numeric_radix && (c) == PL_numeric_radix)
+         PL_numeric_radix && memEQ(s, SvPVX(PL_numeric_radix), SvCUR(PL_numeric_radix)))
 
 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \
        bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \

diff --git a/sv.c b/sv.c
index 7bd628e..09ca49a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2448,6 +2448,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
     I32 numtype = 0;
     I32 sawinf  = 0;
     STRLEN len;
+    bool specialradix = FALSE;
 
     if (SvPOK(sv)) {
        sbegin = SvPVX(sv);
@@ -2514,10 +2515,13 @@ Perl_looks_like_number(pTHX_ SV *sv)
 
         if (*s == '.'
 #ifdef USE_LOCALE_NUMERIC
-           || IS_NUMERIC_RADIX(*s)
+           || (specialradix = IS_NUMERIC_RADIX(s))
 #endif
            ) {
-           s++;
+           if (specialradix)
+               s += SvCUR(PL_numeric_radix);
+           else
+               s++;
            numtype |= IS_NUMBER_NOT_INT;
             while (isDIGIT(*s))  /* optional digits after the radix */
                 s++;
@@ -2525,10 +2529,13 @@ Perl_looks_like_number(pTHX_ SV *sv)
     }
     else if (*s == '.'
 #ifdef USE_LOCALE_NUMERIC
-           || IS_NUMERIC_RADIX(*s)
+           || (specialradix = IS_NUMERIC_RADIX(s))
 #endif
            ) {
-        s++;
+       if (specialradix)
+           s += SvCUR(PL_numeric_radix);
+       else
+           s++;
        numtype |= IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_NOT_INT;
         /* no digits before the radix means we need digits after it */
         if (isDIGIT(*s)) {

diff --git a/util.c b/util.c
index ca7cacf..1fb9ef2 100644 (file)
--- a/util.c
+++ b/util.c
@@ -575,11 +575,18 @@ Perl_set_numeric_radix(pTHX)
     struct lconv* lc;
 
     lc = localeconv();
-    if (lc && lc->decimal_point)
-       /* We assume that decimal separator aka the radix
-        * character is always a single character.  If it
-        * ever is a string, this needs to be rethunk. */
-       PL_numeric_radix = *lc->decimal_point;
+    if (lc && lc->decimal_point) {
+       if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
+           SvREFCNT_dec(PL_numeric_radix);
+           PL_numeric_radix = 0;
+       }
+       else {
+           if (PL_numeric_radix)
+               sv_setpv(PL_numeric_radix, lc->decimal_point);
+           else
+               PL_numeric_radix = newSVpv(lc->decimal_point, 0);
+       }
+    }
     else
        PL_numeric_radix = 0;
 # endif /* HAS_LOCALECONV */