This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
34d3bd4e75dc9c71e8d29380e5970a415b7ffeaf
[perl5.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 GetOptions (
28     "help|?"    => sub { usage (0); },
29     "l|list!"   => \$opt_l,
30     "regen"     => \$opt_r,
31     "default=s" => \$default,
32     ) or usage (1);
33
34 require 'regen/regen_lib.pl' if $opt_r;
35
36 my $MASTER_CFG = "config_h.SH";
37 # Inclusive bounds on the main part of the file, $section == 1 below:
38 my $first = qr/^Author=/;
39 my $last = qr/^zip=/;
40
41 my @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            "epoc/config.sh",
47            "NetWare/config.wc",
48            "symbian/config.sh",
49            "uconfig.sh",
50            "uconfig64.sh",
51            "plan9/config_sh.sample",
52            "win32/config.gc",
53            "win32/config.gc64",
54            "win32/config.gc64nox",
55            "win32/config.vc",
56            "win32/config.vc64",
57            "win32/config.ce",
58            "configure.com",
59            "Porting/config.sh",
60           );
61
62 my @MASTER_CFG;
63 {
64     my %seen;
65     open my $fh, '<', $MASTER_CFG;
66     while (<$fh>) {
67         while (/[^\\]\$([a-z]\w+)/g) {
68             my $v = $1;
69             next if $v =~ /^(CONFIG_H|CONFIG_SH)$/;
70             $seen{$v}++;
71         }
72     }
73     close $fh;
74     @MASTER_CFG = sort keys %seen;
75 }
76
77 my %MANIFEST;
78
79 {
80     open my $fh, '<', 'MANIFEST';
81     while (<$fh>) {
82         $MANIFEST{$1}++ if /^(.+?)\t/;
83     }
84     close $fh;
85 }
86
87 for my $cfg (sort @CFG) {
88     unless (exists $MANIFEST{$cfg}) {
89         print STDERR "[skipping not-expected '$cfg']\n";
90         next;
91     }
92     my %cfg;
93     my $section = 0;
94     my @lines;
95
96     open my $fh, '<', $cfg;
97
98     if ($cfg eq 'configure.com') {
99         ++$cfg{startperl}; # Cheat.
100
101         while (<$fh>) {
102             next if /^\#/ || /^\s*$/ || /^\:/;
103             s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace
104             ++$cfg{$1} if /^\$\s+WC "(\w+)='(?:.*)'"$/;
105         }
106     } else {
107         while (<$fh>) {
108             if ($_ =~ $first) {
109                 die "$cfg:$.:section=$section:$_" unless $section == 0;
110                 $section = 1;
111             }
112             push @{$lines[$section]}, $_;
113             next if /^\#/ || /^\s*$/ || /^\:/;
114             if ($_ =~ $last) {
115                 die "$cfg:$.:section=$section:$_" unless $section == 1;
116                 $section = 2;
117             }
118             # foo='bar'
119             # foo=bar
120             # (optionally with a trailing comment)
121             if (/^(\w+)=(?:'.*'|[^'].*)(?: #.*)?$/) {
122                 ++$cfg{$1};
123             } else {
124                 warn "$cfg:$.:$_";
125             }
126         }
127     }
128     close $fh;
129
130     my $problems;
131     if ($cfg ne 'configure.com') {
132         if (join("", @{$lines[1]}) ne join("", sort @{$lines[1]})) {
133             ++$problems;
134             if ($opt_r) {
135                 @{$lines[1]} = sort @{$lines[1]};
136             } elsif ($opt_l) {
137                 print "$cfg\n";
138             }
139             else {
140                 print "$cfg: unsorted\n";
141             }
142         }
143     }
144     for my $v (@MASTER_CFG) {
145         exists $cfg{$v} and next;
146         if (defined $default && $cfg ne 'configure.com') {
147             push @{$lines[1]}, "$v='$default'\n";
148             ++$problems;
149         } elsif ($opt_l) {
150             # print the name once, for the first problem we encounter.
151             print "$cfg\n" unless $problems++;
152         }
153         else {
154             print "$cfg: missing '$v'\n";
155         }
156     }
157     if ($problems && $opt_r) {
158         @{$lines[1]} = sort @{$lines[1]};
159         my $fh = open_new($cfg);
160         print $fh @{$_} foreach @lines;
161         close_and_rename($fh);
162     }
163 }