1#!/usr/bin/perl 2 3# Check that the various config.sh-clones have (at least) all the 4# same symbols as the top-level config_h.SH so that the (potentially) 5# needed symbols are not lagging after how Configure thinks the world 6# is laid out. 7# 8# VMS is probably not handled properly here, due to their own 9# rather elaborate DCL scripting. 10# 11 12use strict; 13use warnings; 14use autodie; 15 16sub usage 17{ 18 my $err = shift and select STDERR; 19 print "usage: $0 [--list] [--regen] [--default=value]\n"; 20 exit $err; 21 } # usage 22 23use Getopt::Long; 24my $opt_l = 0; 25my $opt_r = 0; 26my $default; 27my $tap = 0; 28my $test; 29GetOptions ( 30 "help|?" => sub { usage (0); }, 31 "l|list!" => \$opt_l, 32 "regen" => \$opt_r, 33 "default=s" => \$default, 34 "tap" => \$tap, 35 ) or usage (1); 36 37$default and $default =~ s/^'(.*)'$/$1/; # Will be quoted on generation 38 39require './regen/regen_lib.pl' if $opt_r; 40 41my $MASTER_CFG = "config_h.SH"; 42# Inclusive bounds on the main part of the file, $section == 1 below: 43my $first = qr/^Author=/; 44my $last = qr/^zip=/; 45 46my @CFG = ( 47 # we check from MANIFEST whether they are expected to be present. 48 # We can't base our check on $], because that's the version of the 49 # perl that we are running, not the version of the source tree. 50 "Cross/config.sh-arm-linux", 51 "Cross/config.sh-arm-linux-n770", 52 "NetWare/config.wc", 53 "symbian/config.sh", 54 "uconfig.sh", 55 "uconfig64.sh", 56 "plan9/config_sh.sample", 57 "win32/config.gc", 58 "win32/config.vc", 59 "win32/config.ce", 60 "configure.com", 61 "Porting/config.sh", 62 ); 63 64my @MASTER_CFG; 65{ 66 my %seen; 67 open my $fh, '<', $MASTER_CFG; 68 while (<$fh>) { 69 while (/[^\\]\$([a-z]\w+)/g) { 70 my $v = $1; 71 next if $v =~ /^(CONFIG_H|CONFIG_SH)$/; 72 $seen{$v}++; 73 } 74 } 75 close $fh; 76 @MASTER_CFG = sort keys %seen; 77} 78 79my %MANIFEST; 80 81{ 82 open my $fh, '<', 'MANIFEST'; 83 while (<$fh>) { 84 $MANIFEST{$1}++ if /^(.+?)\t/; 85 } 86 close $fh; 87} 88 89printf "1..%d\n", 2 * @CFG if $tap; 90 91for my $cfg (sort @CFG) { 92 unless (exists $MANIFEST{$cfg}) { 93 print STDERR "[skipping not-expected '$cfg']\n"; 94 next; 95 } 96 my %cfg; 97 my $section = 0; 98 my @lines; 99 100 open my $fh, '<', $cfg; 101 102 if ($cfg eq 'configure.com') { 103 ++$cfg{startperl}; # Cheat. 104 105 while (<$fh>) { 106 next if /^\#/ || /^\s*$/ || /^\:/; 107 s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace 108 ++$cfg{$1} if /^\$\s+WC "(\w+)='(?:.*)'"$/; 109 } 110 } else { 111 while (<$fh>) { 112 if ($_ =~ $first) { 113 die "$cfg:$.:section=$section:$_" unless $section == 0; 114 $section = 1; 115 } 116 push @{$lines[$section]}, $_; 117 next if /^\#/ || /^\s*$/ || /^\:/; 118 if ($_ =~ $last) { 119 die "$cfg:$.:section=$section:$_" unless $section == 1; 120 $section = 2; 121 } 122 # foo='bar' 123 # foo=bar 124 # (optionally with a trailing comment) 125 if (/^(\w+)=(?:'.*'|[^'].*)(?: #.*)?$/) { 126 ++$cfg{$1}; 127 } else { 128 warn "$cfg:$.:$_"; 129 } 130 } 131 } 132 close $fh; 133 134 ++$test; 135 my $missing; 136 if ($cfg eq 'configure.com') { 137 print "ok $test # skip $cfg doesn't need to be sorted\n" 138 if $tap; 139 } elsif (join("", @{$lines[1]}) eq join("", sort @{$lines[1]})) { 140 print "ok $test - $cfg sorted\n" 141 if $tap; 142 } elsif ($tap) { 143 print "not ok $test - $cfg is not sorted\n"; 144 } elsif ($opt_r || $opt_l) { 145 # A reference to an empty array is true, hence this flags the 146 # file for later attention by --regen and --list, even if 147 # nothing is missing. Actual sort and output are done later. 148 $missing = []; 149 } else { 150 print "$cfg: unsorted\n" 151 } 152 153 for my $v (@MASTER_CFG) { 154 # This only creates a reference in $missing if something is missing: 155 push @$missing, $v unless exists $cfg{$v}; 156 } 157 158 ++$test; 159 if ($missing) { 160 if ($tap) { 161 print "not ok $test - $cfg missing keys @$missing\n"; 162 } elsif ($opt_l) { 163 # print the name once, however many problems 164 print "$cfg\n"; 165 } elsif ($opt_r && $cfg ne 'configure.com') { 166 if (defined $default) { 167 push @{$lines[1]}, map {"$_='$default'\n"} @$missing; 168 } else { 169 print "$cfg: missing '$_', use --default to add it\n" 170 foreach @$missing; 171 } 172 173 @{$lines[1]} = sort @{$lines[1]}; 174 my $fh = open_new($cfg); 175 print $fh @{$_} foreach @lines; 176 close_and_rename($fh); 177 } else { 178 print "$cfg: missing '$_'\n" foreach @$missing; 179 } 180 } elsif ($tap) { 181 print "ok $test - $cfg has no missing keys\n"; 182 } 183} 184