projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (parent: 88e7acd)
Locales support (setlocale) fixes
Vadim Konovalov [Sat, 4 Nov 2000 10:15:48 +0000 (13:15 +0300)]
From: "Konovalov, Vadim" <vkonovalov@lucent.com>
Message-ID: <402099F49BEED211999700805FC7359F82511F@ru0028exch01.spb.lucent.com>

Modified quite a bit to be more portable.

p4raw-id: //depot/perl@7545

embed.h patch | blob | blame | history
embed.pl patch | blob | blame | history
perl.h patch | blob | blame | history
proto.h patch | blob | blame | history
util.c patch | blob | blame | history

diff --git a/embed.h b/embed.h
index c50ff16..b9e7c68 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1135,6 +1135,7 @@
 #define isa_lookup             S_isa_lookup
 #endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
+#define stdize_locale          S_stdize_locale
 #define mess_alloc             S_mess_alloc
 #  if defined(LEAKTEST)
 #define xstat                  S_xstat
@@ -2588,6 +2589,7 @@
 #define isa_lookup(a,b,c,d)    S_isa_lookup(aTHX_ a,b,c,d)
 #endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
+#define stdize_locale(a)       S_stdize_locale(aTHX_ a)
 #define mess_alloc()           S_mess_alloc(aTHX)
 #  if defined(LEAKTEST)
 #define xstat(a)               S_xstat(aTHX_ a)
@@ -5023,6 +5025,8 @@
 #define isa_lookup             S_isa_lookup
 #endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
+#define S_stdize_locale                CPerlObj::S_stdize_locale
+#define stdize_locale          S_stdize_locale
 #define S_mess_alloc           CPerlObj::S_mess_alloc
 #define mess_alloc             S_mess_alloc
 #  if defined(LEAKTEST)
diff --git a/embed.pl b/embed.pl
index 99b73ed..cdf63ef 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1852,9 +1852,9 @@ Apd       |HV*    |get_hv         |const char* name|I32 create
 Apd    |CV*    |get_cv         |const char* name|I32 create
 Ap     |int    |init_i18nl10n  |int printwarn
 Ap     |int    |init_i18nl14n  |int printwarn
-Ap     |void   |new_collate    |const char* newcoll
-Ap     |void   |new_ctype      |const char* newctype
-Ap     |void   |new_numeric    |const char* newcoll
+Ap     |void   |new_collate    |char* newcoll
+Ap     |void   |new_ctype      |char* newctype
+Ap     |void   |new_numeric    |char* newcoll
 Ap     |void   |set_numeric_local
 Ap     |void   |set_numeric_radix
 Ap     |void   |set_numeric_standard
@@ -2521,6 +2521,7 @@ s |SV*|isa_lookup |HV *stash|const char *name|int len|int level
 #endif
 
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
+s      |char*  |stdize_locale  |char* locs
 s      |SV*    |mess_alloc
 #  if defined(LEAKTEST)
 s      |void   |xstat          |int
diff --git a/perl.h b/perl.h
index 6f46dcd..80bf5ae 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3139,16 +3139,10 @@ typedef struct am_table_short AMTS;
 #ifdef USE_LOCALE_NUMERIC
 
 #define SET_NUMERIC_STANDARD() \
-    STMT_START {                               \
-       if (! PL_numeric_standard)              \
-           set_numeric_standard();             \
-    } STMT_END
+       set_numeric_standard();
 
 #define SET_NUMERIC_LOCAL() \
-    STMT_START {                               \
-       if (! PL_numeric_local)                 \
-           set_numeric_local();                \
-    } STMT_END
+       set_numeric_local();
 
 #define IS_NUMERIC_RADIX(c)    \
        ((PL_hints & HINT_LOCALE) && \
@@ -3156,11 +3150,11 @@ typedef struct am_table_short AMTS;
 
 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \
        bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \
-       if (!was_local) SET_NUMERIC_STANDARD();
+       if (was_local) SET_NUMERIC_STANDARD();
 
 #define STORE_NUMERIC_STANDARD_SET_LOCAL() \
-       bool was_standard = !(PL_hints & HINT_LOCALE) || PL_numeric_standard; \
-       if (!was_standard) SET_NUMERIC_LOCAL();
+       bool was_standard = (PL_hints & HINT_LOCALE) && PL_numeric_standard; \
+       if (was_standard) SET_NUMERIC_LOCAL();
 
 #define RESTORE_NUMERIC_LOCAL() \
        if (was_local) SET_NUMERIC_LOCAL();
diff --git a/proto.h b/proto.h
index 1d0f855..ff923a6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -595,9 +595,9 @@ PERL_CALLCONV HV*   Perl_get_hv(pTHX_ const char* name, I32 create);
 PERL_CALLCONV CV*      Perl_get_cv(pTHX_ const char* name, I32 create);
 PERL_CALLCONV int      Perl_init_i18nl10n(pTHX_ int printwarn);
 PERL_CALLCONV int      Perl_init_i18nl14n(pTHX_ int printwarn);
-PERL_CALLCONV void     Perl_new_collate(pTHX_ const char* newcoll);
-PERL_CALLCONV void     Perl_new_ctype(pTHX_ const char* newctype);
-PERL_CALLCONV void     Perl_new_numeric(pTHX_ const char* newcoll);
+PERL_CALLCONV void     Perl_new_collate(pTHX_ char* newcoll);
+PERL_CALLCONV void     Perl_new_ctype(pTHX_ char* newctype);
+PERL_CALLCONV void     Perl_new_numeric(pTHX_ char* newcoll);
 PERL_CALLCONV void     Perl_set_numeric_local(pTHX);
 PERL_CALLCONV void     Perl_set_numeric_radix(pTHX);
 PERL_CALLCONV void     Perl_set_numeric_standard(pTHX);
@@ -1257,6 +1257,7 @@ STATIC SV*        S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level);
 #endif
 
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
+STATIC char*   S_stdize_locale(pTHX_ char* locs);
 STATIC SV*     S_mess_alloc(pTHX);
 #  if defined(LEAKTEST)
 STATIC void    S_xstat(pTHX_ int);
diff --git a/util.c b/util.c
index 619c5aa..34cdaaf 100644 (file)
--- a/util.c
+++ b/util.c
@@ -466,7 +466,7 @@ Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *lit
  * Set up for a new ctype locale.
  */
 void
-Perl_new_ctype(pTHX_ const char *newctype)
+Perl_new_ctype(pTHX_ char *newctype)
 {
 #ifdef USE_LOCALE_CTYPE
 
@@ -485,10 +485,54 @@ Perl_new_ctype(pTHX_ const char *newctype)
 }
 
 /*
+ * Standardize the locale name from a string returned by 'setlocale'.
+ *
+ * The standard return value of setlocale() is either
+ * (1) "xx_YY" if the first argument of setlocale() is not LC_ALL
+ * (2) "xa_YY xb_YY ..." if the first argument of setlocale() is LC_ALL
+ *     (the space-separated values represent the various sublocales,
+ *      in some unspecificed order)
+ *
+ * In some platforms it has a form like "LC_SOMETHING=Lang_Country.866\n",
+ * which is harmful for further use of the string in setlocale().
+ *
+ */
+STATIC char *
+S_stdize_locale(pTHX_ char *locs)
+{
+    char *s;
+    bool okay = TRUE;
+
+    if ((s = strchr(locs, '='))) {
+       char *t;
+
+       okay = FALSE;
+       if ((t = strchr(s, '.'))) {
+           char *u;
+
+           if ((u = strchr(t, '\n'))) {
+
+               if (u[1] == 0) {
+                   STRLEN len = u - s;
+                   Move(t + 1, locs, len, char);
+                   locs[len] = 0;
+                   okay = TRUE;
+               }
+           }
+       }
+    }
+
+    if (!okay)
+       Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs);
+
+    return locs;
+}
+
+/*
  * Set up for a new collation locale.
  */
 void
-Perl_new_collate(pTHX_ const char *newcoll)
+Perl_new_collate(pTHX_ char *newcoll)
 {
 #ifdef USE_LOCALE_COLLATE
 
@@ -497,17 +541,17 @@ Perl_new_collate(pTHX_ const char *newcoll)
            ++PL_collation_ix;
            Safefree(PL_collation_name);
            PL_collation_name = NULL;
-           PL_collation_standard = TRUE;
-           PL_collxfrm_base = 0;
-           PL_collxfrm_mult = 2;
        }
+       PL_collation_standard = TRUE;
+       PL_collxfrm_base = 0;
+       PL_collxfrm_mult = 2;
        return;
     }
 
     if (! PL_collation_name || strNE(PL_collation_name, newcoll)) {
        ++PL_collation_ix;
        Safefree(PL_collation_name);
-       PL_collation_name = savepv(newcoll);
+       PL_collation_name = stdize_locale(savepv(newcoll));
        PL_collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX"));
 
        {
@@ -551,7 +595,7 @@ Perl_set_numeric_radix(pTHX)
  * Set up for a new numeric locale.
  */
 void
-Perl_new_numeric(pTHX_ const char *newnum)
+Perl_new_numeric(pTHX_ char *newnum)
 {
 #ifdef USE_LOCALE_NUMERIC
 
@@ -559,15 +603,15 @@ Perl_new_numeric(pTHX_ const char *newnum)
        if (PL_numeric_name) {
            Safefree(PL_numeric_name);
            PL_numeric_name = NULL;
-           PL_numeric_standard = TRUE;
-           PL_numeric_local = TRUE;
        }
+       PL_numeric_standard = TRUE;
+       PL_numeric_local = TRUE;
        return;
     }
 
     if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) {
        Safefree(PL_numeric_name);
-       PL_numeric_name = savepv(newnum);
+       PL_numeric_name = stdize_locale(savepv(newnum));
        PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
        PL_numeric_local = TRUE;
        set_numeric_radix();
@@ -585,6 +629,7 @@ Perl_set_numeric_standard(pTHX)
        setlocale(LC_NUMERIC, "C");
        PL_numeric_standard = TRUE;
        PL_numeric_local = FALSE;
+       set_numeric_radix();
     }
 
 #endif /* USE_LOCALE_NUMERIC */
Unnamed repository; edit this file to name it for gitweb.