use strict;
use warnings;
+use autodie;
sub usage
{
my $err = shift and select STDERR;
- print "usage: $0 [--list]\n";
+ print "usage: $0 [--list] [--regen] [--default=value]\n";
exit $err;
} # usage
use Getopt::Long;
my $opt_l = 0;
+my $opt_r = 0;
+my $default;
+my $tap = 0;
+my $test;
GetOptions (
"help|?" => sub { usage (0); },
"l|list!" => \$opt_l,
+ "regen" => \$opt_r,
+ "default=s" => \$default,
+ "tap" => \$tap,
) or usage (1);
+require 'regen/regen_lib.pl' if $opt_r;
+
my $MASTER_CFG = "config_h.SH";
-my %MASTER_CFG;
+# Inclusive bounds on the main part of the file, $section == 1 below:
+my $first = qr/^Author=/;
+my $last = qr/^zip=/;
-my %lst;
my @CFG = (
- # This list contains both 5.8.x and 5.9.x files,
# we check from MANIFEST whether they are expected to be present.
# We can't base our check on $], because that's the version of the
# perl that we are running, not the version of the source tree.
"Cross/config.sh-arm-linux",
- "epoc/config.sh",
"NetWare/config.wc",
"symbian/config.sh",
"uconfig.sh",
"uconfig64.sh",
"plan9/config_sh.sample",
- "vos/config.alpha.def",
- "vos/config.ga.def",
- "win32/config.bc",
"win32/config.gc",
- "win32/config.gc64",
- "win32/config.gc64nox",
"win32/config.vc",
- "win32/config.vc64",
"win32/config.ce",
"configure.com",
"Porting/config.sh",
);
-sub read_file {
- my ($fn, $sub) = @_;
- if (open(my $fh, $fn)) {
- local $_;
- while (<$fh>) {
- &$sub;
- }
- } else {
- die "$0: Failed to open '$fn' for reading: $!\n";
- }
-}
-
-sub config_h_SH_reader {
- my $cfg = shift;
- return sub {
+my @MASTER_CFG;
+{
+ my %seen;
+ open my $fh, '<', $MASTER_CFG;
+ while (<$fh>) {
while (/[^\\]\$([a-z]\w+)/g) {
my $v = $1;
next if $v =~ /^(CONFIG_H|CONFIG_SH)$/;
- $cfg->{$v}++;
+ $seen{$v}++;
}
}
+ close $fh;
+ @MASTER_CFG = sort keys %seen;
}
-read_file($MASTER_CFG,
- config_h_SH_reader(\%MASTER_CFG));
-
my %MANIFEST;
-read_file("MANIFEST",
- sub {
- $MANIFEST{$1}++ if /^(.+?)\t/;
- });
-
-my @MASTER_CFG = sort keys %MASTER_CFG;
-
-sub check_cfg {
- my ($fn, $cfg) = @_;
- for my $v (@MASTER_CFG) {
- exists $cfg->{$v} and next;
- if ($opt_l) {
- $lst{$fn}{$v}++;
- }
- else {
- print "$fn: missing '$v'\n";
- }
+{
+ open my $fh, '<', 'MANIFEST';
+ while (<$fh>) {
+ $MANIFEST{$1}++ if /^(.+?)\t/;
}
+ close $fh;
}
-for my $cfg (@CFG) {
+printf "1..%d\n", 2 * @CFG if $tap;
+
+for my $cfg (sort @CFG) {
unless (exists $MANIFEST{$cfg}) {
print STDERR "[skipping not-expected '$cfg']\n";
next;
}
my %cfg;
- read_file($cfg,
- sub {
- return if /^\#/ || /^\s*$/ || /^\:/;
- if ($cfg eq 'configure.com') {
- s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace
- return if ! /^\$\s+WC "(\w+)='(.*)'"$/;
- }
- # foo='bar'
- # foo=bar
- # $foo='bar' # VOS 5.8.x specialty
- # $foo=bar # VOS 5.8.x specialty
- if (/^\$?(\w+)='(.*)'$/) {
- $cfg{$1}++;
- }
- elsif (/^\$?(\w+)=(.*)$/) {
- $cfg{$1}++;
- }
- elsif (/^\$\s+WC "(\w+)='(.*)'"$/) {
- $cfg{$1}++;
- } else {
- warn "$cfg:$.:$_";
- }
- });
+ my $section = 0;
+ my @lines;
+
+ open my $fh, '<', $cfg;
+
if ($cfg eq 'configure.com') {
- $cfg{startperl}++; # Cheat.
+ ++$cfg{startperl}; # Cheat.
+
+ while (<$fh>) {
+ next if /^\#/ || /^\s*$/ || /^\:/;
+ s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace
+ ++$cfg{$1} if /^\$\s+WC "(\w+)='(?:.*)'"$/;
+ }
+ } else {
+ while (<$fh>) {
+ if ($_ =~ $first) {
+ die "$cfg:$.:section=$section:$_" unless $section == 0;
+ $section = 1;
+ }
+ push @{$lines[$section]}, $_;
+ next if /^\#/ || /^\s*$/ || /^\:/;
+ if ($_ =~ $last) {
+ die "$cfg:$.:section=$section:$_" unless $section == 1;
+ $section = 2;
+ }
+ # foo='bar'
+ # foo=bar
+ # (optionally with a trailing comment)
+ if (/^(\w+)=(?:'.*'|[^'].*)(?: #.*)?$/) {
+ ++$cfg{$1};
+ } else {
+ warn "$cfg:$.:$_";
+ }
+ }
+ }
+ close $fh;
+
+ ++$test;
+ my $missing;
+ if ($cfg eq 'configure.com') {
+ print "ok $test # skip $cfg doesn't need to be sorted\n"
+ if $tap;
+ } elsif (join("", @{$lines[1]}) eq join("", sort @{$lines[1]})) {
+ print "ok $test - $cfg sorted\n"
+ if $tap;
+ } elsif ($tap) {
+ print "not ok $test - $cfg is not sorted\n";
+ } elsif ($opt_r || $opt_l) {
+ # A reference to an empty array is true, hence this flags the
+ # file for later attention by --regen and --list, even if
+ # nothing is missing. Actual sort and output are done later.
+ $missing = [];
+ } else {
+ print "$cfg: unsorted\n"
+ }
+
+ for my $v (@MASTER_CFG) {
+ # This only creates a reference in $missing if something is missing:
+ push @$missing, $v unless exists $cfg{$v};
}
- check_cfg($cfg, \%cfg);
-}
-$opt_l and print "$_\n" for sort keys %lst;
+ ++$test;
+ if ($missing) {
+ if ($tap) {
+ print "not ok $test - $cfg missing keys @$missing\n";
+ } elsif ($opt_l) {
+ # print the name once, however many problems
+ print "$cfg\n";
+ } elsif ($opt_r && $cfg ne 'configure.com') {
+ if (defined $default) {
+ push @{$lines[1]}, map {"$_='$default'\n"} @$missing;
+ } else {
+ print "$cfg: missing '$_', use --default to add it\n"
+ foreach @$missing;
+ }
+
+ @{$lines[1]} = sort @{$lines[1]};
+ my $fh = open_new($cfg);
+ print $fh @{$_} foreach @lines;
+ close_and_rename($fh);
+ } else {
+ print "$cfg: missing '$_'\n" foreach @$missing;
+ }
+ } elsif ($tap) {
+ print "ok $test - $cfg has no missing keys\n";
+ }
+}
https://perl5.git.perl.org / perl5.git / blobdiff