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
12use strict;
13use warnings;
14use autodie;
15
16sub usage
17{
18    my $err = shift and select STDERR;
19    print "usage: $0 [--list] [--regen] [--default=value]\n";
20    exit $err;
21    } # usage
22
23use Getopt::Long;
24my $opt_l = 0;
25my $opt_r = 0;
26my $default;
27my $tap = 0;
28my $test;
29GetOptions (
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
39require './regen/regen_lib.pl' if $opt_r;
40
41my $MASTER_CFG = "config_h.SH";
42# Inclusive bounds on the main part of the file, $section == 1 below:
43my $first = qr/^Author=/;
44my $last = qr/^zip=/;
45
46my @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	   "Cross/config.sh-arm-linux-n770",
52	   "NetWare/config.wc",
53	   "symbian/config.sh",
54	   "uconfig.sh",
55	   "uconfig64.sh",
56	   "plan9/config_sh.sample",
57	   "win32/config.gc",
58	   "win32/config.vc",
59	   "configure.com",
60	   "Porting/config.sh",
61	  );
62
63my @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
78my %MANIFEST;
79
80{
81    open my $fh, '<', 'MANIFEST';
82    while (<$fh>) {
83	$MANIFEST{$1}++ if /^(.+?)\t/;
84    }
85    close $fh;
86}
87
88printf "1..%d\n", 2 * @CFG if $tap;
89
90for 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}
183