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