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