xref: /openbsd/gnu/usr.bin/perl/t/porting/regen.t (revision 3d61058a) 
1#!./perl -w
2
3# Verify that all files generated by perl scripts are up to date.
4
5BEGIN {
6    push @INC, '..' if -f '../TestInit.pm';
7    push @INC, '.' if -f './TestInit.pm';
8}
9use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
10use strict;
11
12require './regen/regen_lib.pl';
13require './t/test.pl';
14$::NO_ENDING = $::NO_ENDING = 1;
15
16if ( $^O eq "VMS" ) {
17  skip_all( "- regen.pl needs porting." );
18}
19if ($^O eq 'dec_osf') {
20    skip_all("$^O cannot handle this test");
21}
22if ( $::IS_EBCDIC || $::IS_EBCDIC) {
23  skip_all( "- We don't regen on EBCDIC." );
24}
25use Config;
26if ( $Config{usecrosscompile} ) {
27  skip_all( "Not all files are available during cross-compilation" );
28}
29
30my $tests = 28; # I can't see a clean way to calculate this automatically.
31
32my %skip = ("regen_perly.pl"    => [qw(perly.act perly.h perly.tab)],
33            "regen/keywords.pl" => [qw(keywords.c keywords.h)],
34            "regen/mk_invlists.pl" => [qw(charclass_invlists.h uni_keywords.h)],
35            "regen/regcharclass.pl" => [qw(regcharclass.h)],
36           );
37
38my %other_requirement = (
39    "regen_perly.pl"        => "requires bison",
40    "regen/keywords.pl"     => "requires Devel::Tokenizer::C",
41    "regen/mk_invlists.pl"  => "needs the Perl you've just built",
42    "regen/regcharclass.pl" => "needs the Perl you've just built",
43);
44
45my %skippable_script_for_target;
46for my $script (keys %other_requirement) {
47    $skippable_script_for_target{$_} = $script
48        for @{ $skip{$script} };
49}
50
51my @files = map {@$_} sort values %skip;
52
53# find out what regen scripts would be executed by regen.pl which
54# is the script that implements `make regen`. We need to know this
55# because we will run regen.pl --tap, and it will in turn
56# so we don't need to execute the scripts it executes directly.
57my %regen_files;
58{
59    open my $fh, '<', 'regen.pl'
60        or die "Can't open regen.pl: $!";
61
62    while (<$fh>) {
63        last if /^__END__/;
64    }
65    die "Can't find __END__ in regen.pl"
66        if eof $fh;
67    while (<$fh>) {
68        chomp $_;
69        ++$regen_files{$_};
70    }
71    close $fh
72        or die "Can't close regen.pl: $!";
73}
74
75# This may look a bit weird but it makes sense. We build a skip hash of
76# all the scripts that we want to avoid executing /explicitly/ during
77# our tests. This includes the files listed in %regen_files because we
78# will execute them via regen.pl instead.
79foreach (
80    qw(
81        charset_translations.pl
82        embed_lib.pl
83        mph.pl
84        regcharclass_multi_char_folds.pl
85        regen_lib.pl
86        sorted_types.pl
87    ),
88    keys %regen_files
89) {
90    ++$skip{"regen/$_"};
91}
92
93
94my @progs = grep {!$skip{$_}} <regen/*.pl>;
95push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y);
96@progs = sort @progs;
97
98plan (tests => $tests + @files + @progs);
99
100OUTER: foreach my $file (@files) {
101    open my $fh, '<', $file or die "Can't open $file: $!";
102    1 while defined($_ = <$fh>) and !/Generated from:/;
103    if (eof $fh) {
104	fail("Can't find 'Generated from' line in $file");
105	next;
106    }
107    my @bad;
108    while (<$fh>) {
109	last if /ex:[^:]+:/;
110	unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) {
111	    chomp $_;
112	    fail("Bad line in $file: '$_'");
113	    next OUTER;
114	}
115
116	my $digest = digest($2);
117	note("$digest $2");
118	push @bad, $2 unless $digest eq $1;
119    }
120    is("@bad", '', "generated $file is up to date");
121    if (@bad && (my $skippable_script = $skippable_script_for_target{$file})) {
122        my $reason = delete $other_requirement{$skippable_script};
123        diag("Note: $skippable_script must be run manually, because it $reason")
124            if $reason;
125    }
126}
127
128my @errors;
129foreach my $prog (@progs) {
130    my $args = qq[-Ilib $prog --tap];
131    note("./perl $args");
132    my $command = "$^X $args";
133    if (system $command) { # if it exits with an error...
134        $command=~s/\s*--tap//;
135        push @errors, $prog eq "regen.pl"
136                          ? "make regen"
137                          : $command;
138    }
139}
140if ( @errors ) {
141    my $commands= join "\n", sort @errors;
142    die "\n\nERROR. There are generated files which are NOT up to date.\n",
143        "You should run the following commands to update these files:\n\n",
144        $commands, "\n\n",
145        "Once they are regenerated you should commit the changes.\n\n";
146}
147