From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sat, 4 Nov 2000 20:42:38 +0000 (+0000)
Subject: Locale tweakery.  Add test case for bug id 20000809.003 to op/misc,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dd8482fcac1d87406d052ae3262cc452d6d23e15;p=p5sagit%2Fp5-mst-13.2.git

Locale tweakery.  Add test case for bug id 20000809.003 to op/misc,
create a "fast path" for locale name probing using "locale -a"
if available, squash finally hopefully the s?printf resetting
the numeric locale (since, IIUC perllocale, it never shouldn't).

p4raw-id: //depot/perl@7540
---

diff --git a/sv.c b/sv.c
index 5fd6533..6feb489 100644
--- a/sv.c
+++ b/sv.c
@@ -6619,15 +6619,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		*--eptr = '#';
 	    *--eptr = '%';
 
-	    {
-		STORE_NUMERIC_STANDARD_SET_LOCAL();
-#ifdef USE_LOCALE_NUMERIC
-		if (!was_standard && maybe_tainted)
-		    *maybe_tainted = TRUE;
-#endif
-		(void)sprintf(PL_efloatbuf, eptr, nv);
-		RESTORE_NUMERIC_STANDARD();
-	    }
+	    (void)sprintf(PL_efloatbuf, eptr, nv);
 
 	    eptr = PL_efloatbuf;
 	    elen = strlen(PL_efloatbuf);
diff --git a/t/op/misc.t b/t/op/misc.t
index f442494..0f10424 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -562,3 +562,36 @@ Modification of a read-only value attempted at - line 2.
 print qw(ab a\b a\\b);
 EXPECT
 aba\ba\b
+########
+# This test is here instead of pragma/locale.t because
+# the bug depends on in the internal state of the locale
+# settings and pragma/locale messes up that state pretty badly.
+# We need a "fresh run".
+use Config;
+my $have_setlocale = $Config{d_setlocale} eq 'define';
+eval {
+    require POSIX;
+};
+$have_setlocale = 0 if $@;
+# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
+# and mingw32 uses said silly CRT
+$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
+exit(0) unless $have_setlocale;
+my @locales;
+if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a|")) {
+    while(<LOCALES>) {
+        chomp;
+        push(@locales, $_);
+    }
+    close(LOCALES);
+}
+exit(0) unless @locales;
+for (@locales) {
+    use POSIX qw(locale_h);
+    use locale;
+    setlocale(LC_NUMERIC, $_) or die "setlocale(LC_NUMERIC, $_): $!";
+    my $s = sprintf "%g %g", 3.1, 3.1;
+    next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
+    print "$_ $s\n";
+}
+EXPECT
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index c8a0df8..82fb684 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -242,13 +242,13 @@ Afrikaans:af:za:1 15
 Arabic:ar:dz eg sa:6 arabic8
 Brezhoneg Breton:br:fr:1 15
 Bulgarski Bulgarian:bg:bg:5
-Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW GB2312 tw.EUC
+Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW Big5 GB2312 tw.EUC
 Hrvatski Croatian:hr:hr:2
 Cymraeg Welsh:cy:cy:1 14 15
 Czech:cs:cz:2
 Dansk Danish:dk:da:1 15
 Nederlands Dutch:nl:be nl:1 15
-English American British:en:au ca gb ie nz us uk:1 15 cp850
+English American British:en:au ca gb ie nz us uk zw:1 15 cp850
 Esperanto:eo:eo:3
 Eesti Estonian:et:ee:4 6 13
 Suomi Finnish:fi:fi:1 15
@@ -271,11 +271,12 @@ Latvian:lv:lv:4 6 13
 Lithuanian:lt:lt:4 6 13
 Macedonian:mk:mk:1 15
 Maltese:mt:mt:3
-Norsk Norwegian:no:no:1 15
+Moldovan:mo:mo:2
+Norsk Norwegian:no no\@nynorsk:no:1 15
 Occitan:oc:es:1 15
 Polski Polish:pl:pl:2
 Rumanian:ro:ro:2
-Russki Russian:ru:ru su ua:5 koi8 koi8r koi8u cp1251
+Russki Russian:ru:ru su ua:5 koi8 koi8r KOI8-R koi8u cp1251
 Serbski Serbian:sr:yu:5
 Slovak:sk:sk:2
 Slovene Slovenian:sl:si:2
@@ -283,10 +284,11 @@ Sqhip Albanian:sq:sq:1 15
 Svenska Swedish:sv:fi se:1 15
 Thai:th:th:11 tis620
 Turkish:tr:tr:9 turkish8
-Yiddish:::1 15
+Yiddish:yi::1 15
 EOF
 
 if ($^O eq 'os390') {
+    # These cause heartburn.  Broken locales?
     $locales =~ s/Svenska Swedish:sv:fi se:1 15\n//;
     $locales =~ s/Thai:th:th:11 tis620\n//;
 }
@@ -326,6 +328,7 @@ sub decode_encodings {
 	    }
 	} else {
 	    push @enc, $_;
+   	    push @enc, "$_.UTF-8";
 	}
     }
     if ($^O eq 'os390') {
@@ -347,32 +350,45 @@ foreach (0..15) {
     trylocale("iso_latin_$_");
 }
 
-foreach my $locale (split(/\n/, $locales)) {
-    my ($locale_name, $language_codes, $country_codes, $encodings) =
-	split(/:/, $locale);
-    my @enc = decode_encodings($encodings);
-    foreach my $loc (split(/ /, $locale_name)) {
-	trylocale($loc);
-	foreach my $enc (@enc) {
-	    trylocale("$loc.$enc");
-	}
-	$loc = lc $loc;
-	foreach my $enc (@enc) {
-	    trylocale("$loc.$enc");
-	}
+$ENV{PATH} = '/bin:/usr/bin';
+
+if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a|")) {
+    while (<LOCALES>) {
+        chomp;
+	trylocale($_);
     }
-    foreach my $lang (split(/ /, $language_codes)) {
-	trylocale($lang);
-	foreach my $country (split(/ /, $country_codes)) {
-	    my $lc = "${lang}_${country}";
-	    trylocale($lc);
+    close(LOCALES);
+} else {
+
+    # This is going to be slow.
+
+    foreach my $locale (split(/\n/, $locales)) {
+	my ($locale_name, $language_codes, $country_codes, $encodings) =
+	    split(/:/, $locale);
+	my @enc = decode_encodings($encodings);
+	foreach my $loc (split(/ /, $locale_name)) {
+	    trylocale($loc);
 	    foreach my $enc (@enc) {
-		trylocale("$lc.$enc");
+		trylocale("$loc.$enc");
 	    }
-	    my $lC = "${lang}_\U${country}";
-	    trylocale($lC);
+	    $loc = lc $loc;
 	    foreach my $enc (@enc) {
-		trylocale("$lC.$enc");
+		trylocale("$loc.$enc");
+	    }
+	}
+	foreach my $lang (split(/ /, $language_codes)) {
+	    trylocale($lang);
+	    foreach my $country (split(/ /, $country_codes)) {
+		my $lc = "${lang}_${country}";
+		trylocale($lc);
+		foreach my $enc (@enc) {
+		    trylocale("$lc.$enc");
+		}
+		my $lC = "${lang}_\U${country}";
+		trylocale($lC);
+		foreach my $enc (@enc) {
+		    trylocale("$lC.$enc");
+		}
 	    }
 	}
     }