From b9a60ec628db853c0bad015d5d7f609aee043ff4 Mon Sep 17 00:00:00 2001 From: Petter Reinholdtsen Date: Tue, 29 Nov 2011 08:06:58 +0000 Subject: [PATCH] Small update. --- linux/glibc/check-locale | 280 ++++++++++++++++++++------------------- 1 file changed, 147 insertions(+), 133 deletions(-) diff --git a/linux/glibc/check-locale b/linux/glibc/check-locale index a2ea0c1f64..9d5baf6340 100755 --- a/linux/glibc/check-locale +++ b/linux/glibc/check-locale @@ -3,10 +3,12 @@ # 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 -# . +# . use warnings; use strict; @@ -34,15 +36,15 @@ sub warning { 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 { @@ -50,101 +52,137 @@ sub check_lc_paper { 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) { -# 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 { - warning "LC_PAPER: unknown paper size."; + warning "LC_PAPER: unknown paper size."; } } 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) { - 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; } ('""', - '""', - '""', - '""', - '""', - '""')); - } 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; } ('""', + '""', + '""', + '""', + '""', + '""')); + } elsif ($line =~ m/^\s*(copy)\s+(\S+)\s*$/) { + } else { + warning "LC_NUMERIC: Unknown keyword '$line'"; + } } } 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: ' info"; } my $section; @@ -157,66 +195,42 @@ for my $filename (@ARGV) { my @lines; %sections = (); while () { - 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); - 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'}}); } -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]"; - } - } -} -- 2.47.2