Integrate mainline again

p4raw-id: //depot/perlio@7550

diff --git a/Configure b/Configure
index 89df03f..13e52db 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Sat Nov  4 01:58:40 EET 2000 [metaconfig 3.0 PL70]
+# Generated on Sun Nov  5 00:37:41 EET 2000 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.org)
 
 cat >/tmp/c1$$ <<EOF
@@ -2264,7 +2264,10 @@ if test -f config.sh; then
        rp="I see a config.sh file.  Shall I use it to set the defaults?"
        . UU/myread
        case "$ans" in
-       n*|N*) echo "OK, I'll ignore it."; mv config.sh config.sh.old;;
+       n*|N*) echo "OK, I'll ignore it."
+               mv config.sh config.sh.old
+               myuname="$newmyuname"
+               ;;
        *)  echo "Fetching default answers from your old config.sh file..." >&4
                tmp_n="$n"
                tmp_c="$c"
@@ -2675,7 +2678,6 @@ cd UU
        ;;
 esac
 test "$override" && . ./optdef.sh
-myuname="$newmyuname"
 
 : Restore computed paths
 for file in $loclist $trylist; do

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/t/lib/b.t b/t/lib/b.t
index fca7f47..2bca033 100755 (executable)
--- a/t/lib/b.t
+++ b/t/lib/b.t
@@ -126,7 +126,7 @@ ok;
 
 chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
 $a = join ',', sort split /,/, $a;
-$a =~ s/-uperlio(?:::\w+)?,//g if $Config{'useperlio'} eq 'define';
+$a =~ s/-uperlio(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 $a =~ s/-uCwd,// if $^O eq 'cygwin';

diff --git a/t/op/misc.t b/t/op/misc.t
index 0f10424..aea14c8 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -589,7 +589,7 @@ exit(0) unless @locales;
 for (@locales) {
     use POSIX qw(locale_h);
     use locale;
-    setlocale(LC_NUMERIC, $_) or die "setlocale(LC_NUMERIC, $_): $!";
+    setlocale(LC_NUMERIC, $_) or next;
     my $s = sprintf "%g %g", 3.1, 3.1;
     next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
     print "$_ $s\n";

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 */