]>
jfr.im git - irc/evilnet/x3.git/blob - languages/validate.pl
5 use vars
qw($field_re %lang %escapes);
10 $field_re = qr/%.*?[diouxXeEfFgGaAcspn%]/;
18 sub split_format
($$$) {
19 my ($language, $key, $format) = @_;
20 my (@fields, @sorted, $indexed, $idx);
22 # C indexes things from argument 1.
23 $fields[0] = { type
=> 'dummy' };
25 # Parse each format field in the string.
26 while ($format =~ /($field_re)/g) {
28 next if substr($field, -1) eq '%';
29 if ($field =~ /^%(\d+\$)(#?0?-? ?\+?)(\*\d+\$|\d*)(.\*\d+\$|\.\d+)?((?:hh?|ll?|L|j|z|t)?.)$/) {
30 if (not defined $indexed) {
32 } elsif (not $indexed) {
33 print "MISMATCH: ${language} ${key}, mix of indexed and unindexed fields\n";
37 $res->{index} = substr($1, 0, -1);
40 $res->{precision
} = $4;
42 $res->{width_idx
} = $1
43 if $res->{width
} and $res->{width
} =~ /^\*\d+\$$/;
45 if $res->{precision
} and $res->{precision
} =~ /^.\*(\d+)\$$/;
47 } elsif ($field =~ /^%(#?0?-? ?\+?)(\*|\d*)(.\*|\.\d+)?((?:hh?|ll?|L|j|z|t)?.)$/) {
48 if (not defined $indexed) {
52 print "MISMATCH: ${language} ${key}, mix of indexed and unindexed fields\n";
58 $res->{precision
} = $3;
60 $res->{width_idx
} = $idx++
61 if $res->{width
} and $res->{width
} eq '*';
62 $res->{prec_idx
} = $idx++
63 if $res->{precision
} and $res->{precision
} eq '.*';
64 $res->{index} = $idx++;
67 print "Unparsed field ${language} ${key}: $field\n";
72 # Go through and make sure they are in fully sorted order, with
73 # precision arguments marked properly.
74 foreach my $field (@fields) {
75 next if $field->{type
} eq 'dummy' or $field->{type
} eq 'width' or $field->{type
} eq 'precision';
76 my $idx = $field->{index};
78 # Check for conflicts with this field.
79 if (my $old = $sorted[$idx]) {
80 if ($old->{type
} ne $field->{type
}) {
81 print "MISMATCH ${key}: ${language} refers to param $idx as both type ".$old->{type
}." and ".$field->{type
}.".\n";
84 if ($old->{precision
} or $field->{precision
}) {
85 if (exists($old->{prec_idx
}) != exists($field->{prec_idx
})) {
86 print "MISMATCH ${key}: ${language} has param $idx with and without a precision argument.\n";
88 } elsif ($old->{prec_idx
} != $field->{prec_idx
}) {
89 print "MISMATCH ${key}: ${language} has param $idx with different precision arguments.\n";
93 if ($old->{width
} or $field->{width
}) {
94 if (exists($old->{width_idx
}) != exists($field->{width_idx
})) {
95 print "MISMATCH ${key}: ${language} has param $idx with and without width argument.\n";
96 } elsif ($old->{width_idx
} != $field->{width_idx
}) {
97 print "MISMATCH ${key}: ${language} has param $idx with different width arguments.\n";
101 $sorted[$idx] = $field;
103 if (exists($field->{width_idx
})) {
104 my $width_idx = $field->{width_idx
};
105 if (my $old = $sorted[$width_idx]) {
106 if ($old->{type
} ne 'width') {
107 print "MISMATCH ${key}: ${language} refers to param $idx as both type ".$old->{type
}." and type width.\n";
111 $sorted[$width_idx] = { type
=> 'width' };
114 if (exists($field->{prec_idx
})) {
115 my $prec_idx = $field->{prec_idx
};
116 # Check for conflicts with this field's precision argument.
117 if (my $old = $sorted[$prec_idx]) {
118 if ($old->{type
} ne 'precision') {
119 print "MISMATCH ${key}: ${language} refers to param $idx as both type ".$old->{type
}." and type precision.\n";
123 $sorted[$prec_idx] = { type
=> 'precision' };
130 sub compare_formats
($$$$) {
131 my ($language, $key, $orig_fmt, $new_fmt) = @_;
133 my @orig_fields = split_format
('C', $key, $orig_fmt);
134 my @new_fields = split_format
($language, $key, $new_fmt);
135 if (scalar(@orig_fields) != scalar(@new_fields)) {
136 print "MISMATCH ${key}: C has ".scalar(@orig_fields)." fields, ${language} has ".scalar(@new_fields)."\n";
139 for (my $x = 1; $x <= $#orig_fields; $x++) {
140 my $orig = $orig_fields[$x];
141 my $new = $new_fields[$x];
142 if (not exists $orig->{type
}) {
143 print "MISMATCH ${key}: C has no type for format $x!\n";
144 } elsif (not exists $new->{type
}) {
145 print "MISMATCH ${key}: ${language} has no type for format $x!\n";
146 } if ($orig->{type
} ne $new->{type
}) {
147 print "MISMATCH ${key}: C refers to argument $x as type ".$orig->{type
}.", ${language} as type ".$new->{type
}.".\n";
150 if ($orig->{width
} or $new->{width
}) {
151 if (not exists ($orig->{width_idx
}) and not exists($new->{width_idx
})) {
152 # both used fixed widths: no problem
153 } elsif (exists($orig->{width_idx
}) and not exists($new->{width_idx
})) {
154 print "MISMATCH ${key}: C has a width argument for format $x, ${language} does not.\n";
155 } elsif (not exists($orig->{width_idx
}) and exists($new->{width_idx
})) {
156 print "MISMATCH ${key}: ${language} has a width argument for format $x, C does not.\n";
157 } elsif ($orig->{width_idx
} != $new->{width_idx
}) {
158 print "MISMATCH ${key}: C and ${language} disagree on width argument for format $x.\n";
161 if ($orig->{precision
} or $new->{precision
}) {
162 if (not exists($orig->{prec_idx
}) and not exists($new->{prec_idx
})) {
163 # both used fixed precisions: no problem
164 } elsif (exists($orig->{prec_idx
}) and not exists($new->{prec_idx
})) {
165 print "MISMATCH ${key}: C has a precision argument for format $x, ${language} does not.\n";
167 } elsif (not exists($orig->{prec_idx
}) and exists($new->{prec_idx
})) {
168 print "MISMATCH ${key}: $language has a precision argument for format $x, C does not.\n";
170 } elsif ($orig->{prec_idx
} != $new->{prec_idx
}) {
171 print "MISMATCH ${key}: C and $language disagree on precision argument for format $x.\n";
178 sub read_language
($) {
180 my $fh = new FileHandle
($fname, "r");
181 return undef unless defined $fh;
183 while (defined($_ = $fh->getline)) {
185 if (my ($key, $val) = /^"(\w+)" "(.+)";$/) {
186 $val =~ s/\\(.)/$escapes{$1}/eg;
189 print "Unrecognized line in $fname: $_\n";
195 $lang{C
} = read_language
("strings.db");
197 foreach my $language (@ARGV) {
198 next if exists $lang{$language};
199 $lang{$language} = read_language
("${language}/strings.db")
200 or die "Unable to read $language: $!";
201 foreach my $key (keys %{$lang{$language}}) {
202 if (not $lang{C
}->{$key}) {
203 print "Extra entry in ${language}: $key\n";
206 compare_formats
($language, $key, $lang{C
}->{$key}, $lang{$language}->{$key});