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