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