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