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