This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lib/locale.t: big speedup
authorDavid Mitchell <davem@iabyn.com>
Wed, 23 Feb 2011 23:12:04 +0000 (23:12 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 23 Feb 2011 23:24:53 +0000 (23:24 +0000)
This fix reduces the time for this test script on my debugging build
from 45 seconds to 6 seconds.

Basically, the structure of the main loop for test 117 now looks like:

    foreach my $x (keys %UPPER) {
        push @f, $x if (... something bad about $x...)
    }
    foreach my $x (keys %lower) {
        push @f, $x if (... something bad about $x...)
    }
    ok(!@f);

Whereas before it looked like:

    foreach my $x (keys %UPPER) {
        push @f, $x if (... something bad about $x...)
        foreach my $x (keys %lower) {
            push @f, $x if (... something bad about $x...)
        }
    }
    ok(!@f);

i.e. the %lower tests were inadvertently repeated many times

lib/locale.t

index 68a4d60..5398c34 100644 (file)
@@ -802,26 +802,26 @@ foreach $Locale (@Locale) {
            # With utf8 both will fail since the locale concept
            # of upper/lower does not work well in Unicode.
            push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
+        }
 
-           foreach my $x (keys %lower) {
-               my $y = uc $x;
-               next unless lc $y eq $x;
-               print "# lower $x uc $y ",
-               $x =~ /$y/i ? 1 : 0, " ",
-               $y =~ /$x/i ? 1 : 0, "\n" if 0;
-               if ($x =~ $re || $y =~ $re) { # See above.
-                   print "# Regex characters in '$x' or '$y', skipping test 117 for locale '$Locale'\n";
-                   next;
-               }
-               # With utf8 both will fail since the locale concept
-               # of upper/lower does not work well in Unicode.
-               push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
+       foreach my $x (keys %lower) {
+           my $y = uc $x;
+           next unless lc $y eq $x;
+           print "# lower $x uc $y ",
+           $x =~ /$y/i ? 1 : 0, " ",
+           $y =~ /$x/i ? 1 : 0, "\n" if 0;
+           if ($x =~ $re || $y =~ $re) { # See above.
+               print "# Regex characters in '$x' or '$y', skipping test 117 for locale '$Locale'\n";
+               next;
            }
-           tryneoalpha($Locale, 117, @f == 0);
-           if (@f) {
-               print "# failed 117 locale '$Locale' characters @f\n"
-           }
-        }
+           # With utf8 both will fail since the locale concept
+           # of upper/lower does not work well in Unicode.
+           push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
+       }
+       tryneoalpha($Locale, 117, @f == 0);
+       if (@f) {
+           print "# failed 117 locale '$Locale' characters @f\n"
+       }
     }
 }