Porting/checkcfgvar.pl

   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 }