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	   "win32/config.ce",
60	   "configure.com",
61	   "Porting/config.sh",
62	  );
63
64my @MASTER_CFG;
65{
66    my %seen;
67    open my $fh, '<', $MASTER_CFG;
68    while (<$fh>) {
69	while (/[^\\]\$([a-z]\w+)/g) {
70	    my $v = $1;
71	    next if $v =~ /^(CONFIG_H|CONFIG_SH)$/;
72	    $seen{$v}++;
73	}
74    }
75    close $fh;
76    @MASTER_CFG = sort keys %seen;
77}
78
79my %MANIFEST;
80
81{
82    open my $fh, '<', 'MANIFEST';
83    while (<$fh>) {
84	$MANIFEST{$1}++ if /^(.+?)\t/;
85    }
86    close $fh;
87}
88
89printf "1..%d\n", 2 * @CFG if $tap;
90
91for my $cfg (sort @CFG) {
92    unless (exists $MANIFEST{$cfg}) {
93	print STDERR "[skipping not-expected '$cfg']\n";
94	next;
95    }
96    my %cfg;
97    my $section = 0;
98    my @lines;
99
100    open my $fh, '<', $cfg;
101
102    if ($cfg eq 'configure.com') {
103	++$cfg{startperl}; # Cheat.
104
105	while (<$fh>) {
106	    next if /^\#/ || /^\s*$/ || /^\:/;
107	    s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace
108	    ++$cfg{$1} if /^\$\s+WC "(\w+)='(?:.*)'"$/;
109	}
110    } else {
111	while (<$fh>) {
112	    if ($_ =~ $first) {
113		die "$cfg:$.:section=$section:$_" unless $section == 0;
114		$section = 1;
115	    }
116	    push @{$lines[$section]}, $_;
117	    next if /^\#/ || /^\s*$/ || /^\:/;
118	    if ($_ =~ $last) {
119		die "$cfg:$.:section=$section:$_" unless $section == 1;
120		$section = 2;
121	    }
122	    # foo='bar'
123	    # foo=bar
124	    # (optionally with a trailing comment)
125	    if (/^(\w+)=(?:'.*'|[^'].*)(?: #.*)?$/) {
126		++$cfg{$1};
127	    } else {
128		warn "$cfg:$.:$_";
129	    }
130	}
131    }
132    close $fh;
133
134    ++$test;
135    my $missing;
136    if ($cfg eq 'configure.com') {
137	print "ok $test # skip $cfg doesn't need to be sorted\n"
138	    if $tap;
139    } elsif (join("", @{$lines[1]}) eq join("", sort @{$lines[1]})) {
140	print "ok $test - $cfg sorted\n"
141	    if $tap;
142    } elsif ($tap) {
143	print "not ok $test - $cfg is not sorted\n";
144    } elsif ($opt_r || $opt_l) {
145	# A reference to an empty array is true, hence this flags the
146	# file for later attention by --regen and --list, even if
147	# nothing is missing. Actual sort and output are done later.
148	$missing = [];
149    } else {
150	print "$cfg: unsorted\n"
151    }
152
153    for my $v (@MASTER_CFG) {
154	# This only creates a reference in $missing if something is missing:
155	push @$missing, $v unless exists $cfg{$v};
156    }
157
158    ++$test;
159    if ($missing) {
160	if ($tap) {
161	    print "not ok $test - $cfg missing keys @$missing\n";
162	} elsif ($opt_l) {
163	    # print the name once, however many problems
164	    print "$cfg\n";
165	} elsif ($opt_r && $cfg ne 'configure.com') {
166	    if (defined $default) {
167		push @{$lines[1]}, map {"$_='$default'\n"} @$missing;
168	    } else {
169		print "$cfg: missing '$_', use --default to add it\n"
170		    foreach @$missing;
171	    }
172
173	    @{$lines[1]} = sort @{$lines[1]};
174	    my $fh = open_new($cfg);
175	    print $fh @{$_} foreach @lines;
176	    close_and_rename($fh);
177	} else {
178	    print "$cfg: missing '$_'\n" foreach @$missing;
179	}
180    } elsif ($tap) {
181	print "ok $test - $cfg has no missing keys\n";
182    }
183}
184