xref: /openbsd-src/gnu/usr.bin/perl/Porting/checkcfgvar.pl (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
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
37require 'regen/regen_lib.pl' if $opt_r;
38
39my $MASTER_CFG = "config_h.SH";
40# Inclusive bounds on the main part of the file, $section == 1 below:
41my $first = qr/^Author=/;
42my $last = qr/^zip=/;
43
44my @CFG = (
45	   # we check from MANIFEST whether they are expected to be present.
46	   # We can't base our check on $], because that's the version of the
47	   # perl that we are running, not the version of the source tree.
48	   "Cross/config.sh-arm-linux",
49	   "NetWare/config.wc",
50	   "symbian/config.sh",
51	   "uconfig.sh",
52	   "uconfig64.sh",
53	   "plan9/config_sh.sample",
54	   "win32/config.gc",
55	   "win32/config.vc",
56	   "win32/config.ce",
57	   "configure.com",
58	   "Porting/config.sh",
59	  );
60
61my @MASTER_CFG;
62{
63    my %seen;
64    open my $fh, '<', $MASTER_CFG;
65    while (<$fh>) {
66	while (/[^\\]\$([a-z]\w+)/g) {
67	    my $v = $1;
68	    next if $v =~ /^(CONFIG_H|CONFIG_SH)$/;
69	    $seen{$v}++;
70	}
71    }
72    close $fh;
73    @MASTER_CFG = sort keys %seen;
74}
75
76my %MANIFEST;
77
78{
79    open my $fh, '<', 'MANIFEST';
80    while (<$fh>) {
81	$MANIFEST{$1}++ if /^(.+?)\t/;
82    }
83    close $fh;
84}
85
86printf "1..%d\n", 2 * @CFG if $tap;
87
88for my $cfg (sort @CFG) {
89    unless (exists $MANIFEST{$cfg}) {
90	print STDERR "[skipping not-expected '$cfg']\n";
91	next;
92    }
93    my %cfg;
94    my $section = 0;
95    my @lines;
96
97    open my $fh, '<', $cfg;
98
99    if ($cfg eq 'configure.com') {
100	++$cfg{startperl}; # Cheat.
101
102	while (<$fh>) {
103	    next if /^\#/ || /^\s*$/ || /^\:/;
104	    s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace
105	    ++$cfg{$1} if /^\$\s+WC "(\w+)='(?:.*)'"$/;
106	}
107    } else {
108	while (<$fh>) {
109	    if ($_ =~ $first) {
110		die "$cfg:$.:section=$section:$_" unless $section == 0;
111		$section = 1;
112	    }
113	    push @{$lines[$section]}, $_;
114	    next if /^\#/ || /^\s*$/ || /^\:/;
115	    if ($_ =~ $last) {
116		die "$cfg:$.:section=$section:$_" unless $section == 1;
117		$section = 2;
118	    }
119	    # foo='bar'
120	    # foo=bar
121	    # (optionally with a trailing comment)
122	    if (/^(\w+)=(?:'.*'|[^'].*)(?: #.*)?$/) {
123		++$cfg{$1};
124	    } else {
125		warn "$cfg:$.:$_";
126	    }
127	}
128    }
129    close $fh;
130
131    ++$test;
132    my $missing;
133    if ($cfg eq 'configure.com') {
134	print "ok $test # skip $cfg doesn't need to be sorted\n"
135	    if $tap;
136    } elsif (join("", @{$lines[1]}) eq join("", sort @{$lines[1]})) {
137	print "ok $test - $cfg sorted\n"
138	    if $tap;
139    } elsif ($tap) {
140	print "not ok $test - $cfg is not sorted\n";
141    } elsif ($opt_r || $opt_l) {
142	# A reference to an empty array is true, hence this flags the
143	# file for later attention by --regen and --list, even if
144	# nothing is missing. Actual sort and output are done later.
145	$missing = [];
146    } else {
147	print "$cfg: unsorted\n"
148    }
149
150    for my $v (@MASTER_CFG) {
151	# This only creates a reference in $missing if something is missing:
152	push @$missing, $v unless exists $cfg{$v};
153    }
154
155    ++$test;
156    if ($missing) {
157	if ($tap) {
158	    print "not ok $test - $cfg missing keys @$missing\n";
159	} elsif ($opt_l) {
160	    # print the name once, however many problems
161	    print "$cfg\n";
162	} elsif ($opt_r && $cfg ne 'configure.com') {
163	    if (defined $default) {
164		push @{$lines[1]}, map {"$_='$default'\n"} @$missing;
165	    } else {
166		print "$cfg: missing '$_', use --default to add it\n"
167		    foreach @$missing;
168	    }
169
170	    @{$lines[1]} = sort @{$lines[1]};
171	    my $fh = open_new($cfg);
172	    print $fh @{$_} foreach @lines;
173	    close_and_rename($fh);
174	} else {
175	    print "$cfg: missing '$_'\n" foreach @$missing;
176	}
177    } elsif ($tap) {
178	print "ok $test - $cfg has no missing keys\n";
179    }
180}
181