X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/fc09a9a0cfd399ade7b09bd087384df6b3d742dc..074331bb276f0a3ccd2f459327a9d9d5e39de87d:/Porting/checkcfgvar.pl diff --git a/Porting/checkcfgvar.pl b/Porting/checkcfgvar.pl index 50daa40..3ebde3a 100755 --- a/Porting/checkcfgvar.pl +++ b/Porting/checkcfgvar.pl @@ -11,131 +11,170 @@ 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"; + } +}