Small update.

diff --git a/linux/glibc/check-locale b/linux/glibc/check-locale
index a2ea0c1f64edc56453792a2ae888cb54d66f1a4d..9d5baf6340e466441eae7ee337d4fe79d95a701a 100755 (executable)
--- a/linux/glibc/check-locale
+++ b/linux/glibc/check-locale
@@ -3,10 +3,12 @@
 # Author: Petter Reinholdtsen
 # Date: 2004-06-01
 #
 # Author: Petter Reinholdtsen
 # Date: 2004-06-01
 #

+# License: GPL v2 or later at your choice
+#

 # Test the content of GNU libc locales, detect some common errors.
 #
 # The latest version is available from
 # Test the content of GNU libc locales, detect some common errors.
 #
 # The latest version is available from

-# <URL:http://www.student.uit.no/~pere/linux/glibc/>.
+# <URL:http://www.hungry.com/~pere/linux/glibc/>.

 
 use warnings;
 use strict;
 
 use warnings;
 use strict;


@@ -34,15 +36,15 @@ sub warning {
 sub check_lc_identification {
     my @lines = @_;
     for my $line (@lines) {
 sub check_lc_identification {
     my @lines = @_;
     for my $line (@lines) {

-       if ($line =~ m/^category\s+(\S+)$/) {
-           warning "LC_IDENTIFICATION: missing quotes around category standard ref: $1"
-               if ($1 !~ m/\".+\"/);
-       }
-       if ($line =~ m/^email\s+(\S+)\s*$/) {
-           my $email = $1;
-           warning "LC_IDENTIFICATION: obsolete email: $email"
-               if ($email =~ m/"?bug-glibc\@gnu.org"?/);
-       }
+        if ($line =~ m/^category\s+(\S+)$/) {
+            warning "LC_IDENTIFICATION: missing quotes around category standard ref: $1"
+                if ($1 !~ m/\".+\"/);
+        }
+        if ($line =~ m/^email\s+(\S+)\s*$/) {
+            my $email = $1;
+            warning "LC_IDENTIFICATION: obsolete email: $email"
+                if ($email =~ m/"?bug-glibc\@gnu.org"?/);
+        }

     }
 }
 sub check_lc_paper {
     }
 }
 sub check_lc_paper {


@@ -50,101 +52,137 @@ sub check_lc_paper {
     my $height = undef;
     my $width = undef;
     for (@lines) {
     my $height = undef;
     my $width = undef;
     for (@lines) {

-       $height = $1 if (m/^height\s*(\d+)\s*$/);
-       $width = $1 if (m/^width\s*(\d+)\s*$/);
-       return if (m/^copy\s+/); # Nothing to check
+        $height = $1 if (m/^height\s*(\d+)\s*$/);
+        $width = $1 if (m/^width\s*(\d+)\s*$/);
+        return if (m/^copy\s+/); # Nothing to check

     }
 
     if (!defined $width || defined $height) {
     }
 
     if (!defined $width || defined $height) {

-#      warning "LC_PAPER: Missing height or width.";
-       return;
+#       warning "LC_PAPER: Missing height or width.";
+        return;

     }
     }

-    
+

     if (210 == $width && 297 == $height) {      # ISO A4
     } elsif (216 == $width && 279 == $height) { # US Letter
     } else {
     if (210 == $width && 297 == $height) {      # ISO A4
     } elsif (216 == $width && 279 == $height) { # US Letter
     } else {

-       warning "LC_PAPER: unknown paper size.";
+        warning "LC_PAPER: unknown paper size.";

     }
 }
 
 sub check_lc_measurement {
     my @lines = @_;
     for my $line (@lines) {
     }
 }
 
 sub check_lc_measurement {
     my @lines = @_;
     for my $line (@lines) {

-       if ($line =~ m/^\s*(measurement)\s+(\S+)\s*$/) {
-           my $value = $2;
-           if (defined $value && $value !~ m/^\d+$/) {
-               warning "LC_MEASUREMENT: measurements should be number 1 or 2.";
-           } elsif  ($value < 1 && 2 < $value) {
-               warning "LC_MEASUREMENT: measurements should be 1 or 2.";
-           }
-       }
+        if ($line =~ m/^\s*(measurement)\s+(\S+)\s*$/) {
+            my $value = $2;
+            if (defined $value && $value !~ m/^\d+$/) {
+                warning "LC_MEASUREMENT: measurements should be number 1 or 2.";
+            } elsif  ($value < 1 && 2 < $value) {
+                warning "LC_MEASUREMENT: measurements should be 1 or 2.";
+            }
+        }

     }
 }
 
 sub check_lc_numeric {
     my @lines = @_;
     for my $line (@lines) {
     }
 }
 
 sub check_lc_numeric {
     my @lines = @_;
     for my $line (@lines) {

-       next if ($line eq "LC_NUMERIC" || $line eq "END LC_NUMERIC");
-       next if ($line =~ m/^$/);
-       if ($line =~ m/^\s*(grouping)\s+(\S+)\s*$/) {
-           my $value = $2;
-           if ($value =~ m/^-?\d+$/) {
-               # Only digits (or - digits)
-               if ( $value < 1 && $value != -1) {
-                   warning "LC_NUMERIC: grouping should positive or -1: $value";
-               }
-           } else {
-               if (defined $value && $value !~ m/\d+;\d+/) {
-                   warning "LC_NUMERIC: grouping should use ; as separator: $value";
-               }
-           }
-       } elsif ($line =~ m/^\s*(decimal_point)\s+(\S+)\s*$/) {
-       } elsif ($line =~ m/^\s*(thousands_sep)\s+(\S+)\s*$/) {
-           my $sep = $2;
-#          print "P: '$sep'\n";
-           warning "LC_NUMERIC: Unusual thousands_sep '$sep' [".
-               uxx_to_utf8($sep)."]"
-               unless (grep { $_ eq $sep; }  ('"<U0020>"',
-                                              '"<U0027>"',
-                                              '"<U002C>"',
-                                              '"<U002E>"',
-                                              '"<U00A0>"',
-                                              '""'));
-       } elsif ($line =~ m/^\s*(copy)\s+(\S+)\s*$/) {
-       } else {
-           warning "LC_NUMERIC: Unknown keyword '$line'";
-       }
+        next if ($line eq "LC_NUMERIC" || $line eq "END LC_NUMERIC");
+        next if ($line =~ m/^$/);
+        if ($line =~ m/^\s*(grouping)\s+(\S+)\s*$/) {
+            my $value = $2;
+            if ($value =~ m/^-?\d+$/) {
+                # Only digits (or - digits)
+                if ( $value < 1 && $value != -1) {
+                    warning "LC_NUMERIC: grouping should positive or -1: $value";
+                }
+            } else {
+                if (defined $value && $value !~ m/\d+;\d+/) {
+                    warning "LC_NUMERIC: grouping should use ; as separator: $value";
+                }
+            }
+        } elsif ($line =~ m/^\s*(decimal_point)\s+(\S+)\s*$/) {
+        } elsif ($line =~ m/^\s*(thousands_sep)\s+(\S+)\s*$/) {
+            my $sep = $2;
+#           print "P: '$sep'\n";
+            warning "LC_NUMERIC: Unusual thousands_sep '$sep' [".
+                uxx_to_utf8($sep)."]"
+                unless (grep { $_ eq $sep; }  ('"<U0020>"',
+                                               '"<U0027>"',
+                                               '"<U002C>"',
+                                               '"<U002E>"',
+                                               '"<U00A0>"',
+                                               '""'));
+        } elsif ($line =~ m/^\s*(copy)\s+(\S+)\s*$/) {
+        } else {
+            warning "LC_NUMERIC: Unknown keyword '$line'";
+        }

     }
 }
 
 sub check_lc_messages {
     my @lines = @_;
     for (@lines) {
     }
 }
 
 sub check_lc_messages {
     my @lines = @_;
     for (@lines) {

-       if (m/^\s*(yesexpr|noexpr)\s+(.+)$/) {
-           my $type  = $1;
-           my $regex = uxx_to_utf8($2);
-           unless ($regex =~ m/^"\^/) {
-               error "LC_MESSAGES: $type missing '^' prefix: $regex";
-           }
-           unless ($regex =~ m/\[.+\]|\(.+\)/) {
-               error "LC_MESSAGES: $type missing '[.+]|(.+)' content: $regex";
-           }
-           if ($regex =~ m/\.\*"$/) {
-               warning "LC_MESSAGES: $type have '.*' postfix: $regex";
-           }
-           if ($regex =~ m/[0-9]/) {
-               warning "LC_MESSAGES: $type have numbers in regex: $regex";
-           }
-           if ($type eq "yesexpr" && ($regex !~ m/y/ ||
-                                      $regex !~ m/Y/)) {
-               warning "LC_MESSAGES: $type missing 'yY' in content: $regex";
-           }
-           if ($type eq "noexpr" && ($regex !~ m/n/ ||
-                                     $regex !~ m/N/)) {
-               warning "LC_MESSAGES: $type missing 'nN' in content: $regex";
-           }
-       }
+        if (m/^\s*(yesexpr|noexpr)\s+(.+)$/) {
+            my $type  = $1;
+            my $regex = uxx_to_utf8($2);
+            unless ($regex =~ m/^"\^/) {
+                error "LC_MESSAGES: $type missing '^' prefix: $regex";
+            }
+            unless ($regex =~ m/\[.+\]|\(.+\)/) {
+                error "LC_MESSAGES: $type missing '[.+]|(.+)' content: $regex";
+            }
+            if ($regex =~ m/\.\*"$/) {
+                warning "LC_MESSAGES: $type have '.*' postfix: $regex";
+            }
+            if ($regex =~ m/[0-9]/) {
+                warning "LC_MESSAGES: $type have numbers in regex: $regex";
+            }
+            if ($type eq "yesexpr" && ($regex !~ m/y/ ||
+                                       $regex !~ m/Y/)) {
+                warning "LC_MESSAGES: $type missing 'yY' in content: $regex";
+            }
+            if ($type eq "noexpr" && ($regex !~ m/n/ ||
+                                      $regex !~ m/N/)) {
+                warning "LC_MESSAGES: $type missing 'nN' in content: $regex";
+            }
+        }
+    }
+}
+
+sub check_order {
+    my @blocks = @_;
+    my @order= qw(LC_IDENTIFICATION
+                  LC_CTYPE
+                  LC_COLLATE
+                  LC_MONETARY
+                  LC_NUMERIC
+                  LC_TIME
+                  LC_MESSAGES
+                  LC_PAPER
+                  LC_NAME
+                  LC_ADDRESS
+                  LC_TELEPHONE
+                  LC_MEASUREMENT);
+    my $pos = 0;
+    for my $section (@blocks) {
+        if ($section eq $order[$pos]) {
+            $pos++;
+        } else {
+            $pos = 0;
+            $pos++ while ($order[$pos] ne $section);
+            warning "$section: not following section $order[$pos-1]";
+        }
+    }
+}
+
+sub check_charset {
+    my @blocks = @_;
+    for my $section (@blocks) {
+        if ($section =~ m/^%\s*[Cc]arset:\s*$/) {
+            return;
+        }

     }
     }

+    warning "Missing '% Charset: <charset>' info";

 }
 
 my $section;
 }
 
 my $section;


@@ -157,66 +195,42 @@ for my $filename (@ARGV) {
     my @lines;
     %sections = ();
     while (<FILE>) {
     my @lines;
     %sections = ();
     while (<FILE>) {

-       chomp;
-       s/%.*$//; # Remove comments
-       s/\#.*$//;
-       if (m%^(.+)/$%) {
-           $buf .= $1;
-           next;
-       }
-       if (! defined $buf) {
-           $buf = $_;
-       } else {
-           $buf .= $_;
-       }
-       if (!$section && m/^(LC_.*)\s*$/) {
-           $section = $1;
-           @lines = ();
-           #print "Found section $section\n";
-       }
-       push(@lines, $buf);
-       if (m/^END (LC_.+)\s*$/) {
-           if (exists $sections{$section}) {
-               warning "duplicate section $section";
-           }
-           push(@blocks, $section);
-           $sections{$section} = [@lines];
-           $section = "";
-           #print "Stored section $section\n";
-       }
-       undef $buf;
+        chomp;
+        s/%.*$//; # Remove comments
+        s/\#.*$//;
+        if (m%^(.+)/$%) {
+            $buf .= $1;
+            next;
+        }
+        if (! defined $buf) {
+            $buf = $_;
+        } else {
+            $buf .= $_;
+        }
+        if (!$section && m/^(LC_.*)\s*$/) {
+            $section = $1;
+            @lines = ();
+            #print "Found section $section\n";
+        }
+        push(@lines, $buf);
+        if (m/^END (LC_.+)\s*$/) {
+            if (exists $sections{$section}) {
+                warning "duplicate section $section";
+            }
+            push(@blocks, $section);
+            $sections{$section} = [@lines];
+            $section = "";
+            #print "Stored section $section\n";
+        }
+        undef $buf;

     }
     close(FILE);
 
     }
     close(FILE);
 

-    check_order(@blocks);
+#    check_order(@blocks);
+    check_charset(@blocks);

     check_lc_identification(@{$sections{'LC_IDENTIFICATION'}});
     check_lc_messages(@{$sections{'LC_MESSAGES'}});
     check_lc_numeric(@{$sections{'LC_NUMERIC'}});
     check_lc_paper(@{$sections{'LC_PAPER'}});
     check_lc_measurement(@{$sections{'LC_MEASUREMENT'}});
 }
     check_lc_identification(@{$sections{'LC_IDENTIFICATION'}});
     check_lc_messages(@{$sections{'LC_MESSAGES'}});
     check_lc_numeric(@{$sections{'LC_NUMERIC'}});
     check_lc_paper(@{$sections{'LC_PAPER'}});
     check_lc_measurement(@{$sections{'LC_MEASUREMENT'}});
 }

-sub check_order {
-    my @blocks = @_;
-    my @order= qw(LC_IDENTIFICATION
-                 LC_CTYPE
-                 LC_COLLATE
-                 LC_MONETARY
-                 LC_NUMERIC
-                 LC_TIME
-                 LC_MESSAGES
-                 LC_PAPER
-                 LC_NAME
-                 LC_ADDRESS
-                 LC_TELEPHONE
-                 LC_MEASUREMENT);
-    my $pos = 0;
-    for my $section (@blocks) {
-       if ($section eq $order[$pos]) {
-           $pos++;
-       } else {
-           $pos = 0;
-           $pos++ while ($order[$pos] ne $section);
-           warning "$section: not following section $order[$pos-1]";
-       }
-    }
-}