More robust yacc/bison failure output handling.

[p5sagit/p5-mst-13.2.git] / t / pragma / locale.t

diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index 05891fa..7e3df8c 100755 (executable)
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -19,6 +19,13 @@ eval {
     $have_setlocale++;
 };
 
+# 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;
+
+# 103 (the last test) may fail but that is okay.
+# (It indicates something broken in the environment, not Perl)
+# Therefore .. only until 102, not 103.
 print "1..", ($have_setlocale ? 102 : 98), "\n";
 
 use vars qw($a
@@ -40,6 +47,7 @@ sub ok {
 # even the default locale will taint under 'use locale'.
 
 sub is_tainted { # hello, camel two.
+    local $^W; # no warnings 'undef'
     my $dummy;
     not eval { $dummy = join("", @_), kill 0; 1 }
 }
@@ -282,22 +290,26 @@ locatelocale(\$Spanish, \@Spanish,
 # Select the largest of the alpha(num)bets.
 
 ($Locale, @Locale) = ($English, @English)
-    if (length(@English) > length(@Locale));
+    if (@English > @Locale);
 ($Locale, @Locale) = ($German, @German)
-    if (length(@German)  > length(@Locale));
+    if (@German  > @Locale);
 ($Locale, @Locale) = ($French, @French)
-    if (length(@French)  > length(@Locale));
+    if (@French  > @Locale);
 ($Locale, @Locale) = ($Spanish, @Spanish)
-    if (length(@Spanish) > length(@Locale));
-
-print "# Locale = $Locale\n";
-print "# Alnum_ = @Locale\n";
+    if (@Spanish > @Locale);
 
 {
     local $^W = 0;
     setlocale(&LC_ALL, $Locale);
 }
 
+# Sort it now that LC_ALL has been set.
+
+@Locale = sort @Locale;
+
+print "# Locale = $Locale\n";
+print "# Alnum_ = @Locale\n";
+
 {
     my $i = 0;
 
@@ -393,11 +405,29 @@ for (map { chr } 0..255) {
 }
 print "ok 101\n";
 
-# The @Locale should be internally consistent.
+# Test for read-onlys.
 
 print "# testing 102\n";
 {
-    my ($from, $to, $lesser, $greater, @test, %test, $test);
+    no locale;
+    $a = "qwerty";
+    {
+       use locale;
+       print "not " if $a cmp "qwerty";
+    }
+}
+print "ok 102\n";
+
+# This test must be the last one because its failure is not fatal.
+# The @Locale should be internally consistent.
+# Thanks to Hallvard Furuseth <h.b.furuseth@usit.uio.no>
+# for inventing a way to test for ordering consistency
+# without requiring any particular order.
+# <jhi@iki.fi>
+
+print "# testing 103\n";
+{
+    my ($from, $to, $lesser, $greater, @test, %test, $test, $yes, $no, $sign);
 
     for (0..9) {
        # Select a slice.
@@ -409,32 +439,35 @@ print "# testing 102\n";
        $from++; $to++;
         $to = $#Locale if ($to > $#Locale);
        $greater = join('', @Locale[$from..$to]);
+       ($yes, $no, $sign) = ($lesser lt $greater
+                               ? ("    ", "not ", 1)
+                               : ("not ", "    ", -1));
+       # all these tests should FAIL (return 0).
        @test = 
            (
-            'not ($lesser  lt $greater)', # 0
-            'not ($lesser  le $greater)', # 1
-            'not ($lesser  ne $greater)', # 2
-            '    ($lesser  eq $greater)', # 3
-            '    ($lesser  ge $greater)', # 4
-            '    ($lesser  gt $greater)', # 5
-            '    ($greater lt $lesser )', # 6
-            '    ($greater le $lesser )', # 7
-            'not ($greater ne $lesser )', # 8
-            '    ($greater eq $lesser )', # 9
-            'not ($greater ge $lesser )', # 10
-            'not ($greater gt $lesser )', # 11
-            # Well, these two are sort of redundant
-            # because @Locale was derived using cmp.
-            'not (($lesser  cmp $greater) == -1)', # 12
-            'not (($greater cmp $lesser ) ==  1)'  # 13
+            $no.'    ($lesser  lt $greater)',  # 0
+            $no.'    ($lesser  le $greater)',  # 1
+            'not      ($lesser  ne $greater)', # 2
+            '         ($lesser  eq $greater)', # 3
+            $yes.'    ($lesser  ge $greater)', # 4
+            $yes.'    ($lesser  gt $greater)', # 5
+            $yes.'    ($greater lt $lesser )', # 6
+            $yes.'    ($greater le $lesser )', # 7
+            'not      ($greater ne $lesser )', # 8
+            '         ($greater eq $lesser )', # 9
+            $no.'     ($greater ge $lesser )', # 10
+            $no.'     ($greater gt $lesser )', # 11
+            'not (($lesser cmp $greater) == -$sign)' # 12
             );
        @test{@test} = 0 x @test;
        $test = 0;
        for my $ti (@test) { $test{$ti} = eval $ti ; $test ||= $test{$ti} }
        if ($test) {
-           print "# failed 102 at:\n";
+           print "# failed 103 at:\n";
            print "# lesser  = '$lesser'\n";
            print "# greater = '$greater'\n";
+           print "# lesser cmp greater = ", $lesser cmp $greater, "\n";
+           print "# greater cmp lesser = ", $greater cmp $lesser, "\n";
            print "# (greater) from = $from, to = $to\n";
            for my $ti (@test) {
                printf("# %-40s %-4s", $ti,
@@ -445,9 +478,10 @@ print "# testing 102\n";
                print "\n";
            }
 
-           print 'not ';
+           warn "The locale definition on your system may have errors.\n";
            last;
        }
     }
 }
-print "ok 102\n";
+
+# eof