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