Commit | Line | Data |
---|---|---|
3879ea51 NC |
1 | #!./perl -w |
2 | ||
3 | # Verify that all files generated by perl scripts are up to date. | |
4 | ||
3879ea51 | 5 | BEGIN { |
208c2b59 | 6 | @INC = '..' if -f '../TestInit.pm'; |
3879ea51 | 7 | } |
208c2b59 | 8 | use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute |
3879ea51 NC |
9 | use strict; |
10 | ||
3d7c117d MB |
11 | require './regen/regen_lib.pl'; |
12 | require './t/test.pl'; | |
c24c946d NC |
13 | $::NO_ENDING = $::NO_ENDING = 1; |
14 | ||
b511b76c CB |
15 | if ( $^O eq "VMS" ) { |
16 | skip_all( "- regen.pl needs porting." ); | |
17 | } | |
fa2edc1a JH |
18 | if ($^O eq 'dec_osf') { |
19 | skip_all("$^O cannot handle this test"); | |
20 | } | |
ff23b6f8 KW |
21 | if ( $::IS_EBCDIC || $::IS_EBCDIC) { |
22 | skip_all( "- We don't regen on EBCDIC." ); | |
23 | } | |
3a73a075 BF |
24 | use Config; |
25 | if ( $Config{usecrosscompile} ) { | |
26 | skip_all( "Not all files are available during cross-compilation" ); | |
27 | } | |
b511b76c | 28 | |
8c3a0f6c | 29 | my $tests = 25; # I can't see a clean way to calculate this automatically. |
c24c946d | 30 | |
0daf6d09 NC |
31 | my %skip = ("regen_perly.pl" => [qw(perly.act perly.h perly.tab)], |
32 | "regen/keywords.pl" => [qw(keywords.c keywords.h)], | |
33 | "regen/uconfig_h.h" => [qw(uconfig.h)], | |
3e376abb | 34 | "regen/mk_invlists.pl" => [qw(charclass_invlists.h uni_keywords.h)], |
542a7545 | 35 | "regen/regcharclass.pl" => [qw(regcharclass.h)], |
0daf6d09 NC |
36 | ); |
37 | ||
5e39bfe1 AC |
38 | my %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 | ||
b7a02455 AC |
45 | my %skippable_script_for_target; |
46 | for my $script (keys %other_requirement) { | |
47 | $skippable_script_for_target{$_} = $script | |
48 | for @{ $skip{$script} }; | |
49 | } | |
50 | ||
0daf6d09 NC |
51 | my @files = map {@$_} sort values %skip; |
52 | ||
53 | open my $fh, '<', 'regen.pl' | |
54 | or die "Can't open regen.pl: $!"; | |
55 | ||
56 | while (<$fh>) { | |
57 | last if /^__END__/; | |
58 | } | |
59 | die "Can't find __END__ in regen.pl" | |
60 | if eof $fh; | |
61 | ||
62 | foreach (qw(embed_lib.pl regen_lib.pl uconfig_h.pl | |
6ff677df KW |
63 | regcharclass_multi_char_folds.pl |
64 | charset_translations.pl | |
1a4d3814 | 65 | mph.pl |
6ff677df | 66 | ), |
0daf6d09 NC |
67 | map {chomp $_; $_} <$fh>) { |
68 | ++$skip{"regen/$_"}; | |
69 | } | |
70 | ||
71 | close $fh | |
72 | or die "Can't close regen.pl: $!"; | |
73 | ||
74 | my @progs = grep {!$skip{$_}} <regen/*.pl>; | |
75 | push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y); | |
76 | ||
77 | plan (tests => $tests + @files + @progs); | |
c24c946d NC |
78 | |
79 | OUTER: foreach my $file (@files) { | |
80 | open my $fh, '<', $file or die "Can't open $file: $!"; | |
81 | 1 while defined($_ = <$fh>) and !/Generated from:/; | |
82 | if (eof $fh) { | |
83 | fail("Can't find 'Generated from' line in $file"); | |
84 | next; | |
85 | } | |
86 | my @bad; | |
87 | while (<$fh>) { | |
88 | last if /ex: set ro:/; | |
89 | unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) { | |
90 | chomp $_; | |
91 | fail("Bad line in $file: '$_'"); | |
92 | next OUTER; | |
93 | } | |
ff23b6f8 | 94 | |
c24c946d NC |
95 | my $digest = digest($2); |
96 | note("$digest $2"); | |
97 | push @bad, $2 unless $digest eq $1; | |
98 | } | |
99 | is("@bad", '', "generated $file is up to date"); | |
b7a02455 AC |
100 | if (@bad && (my $skippable_script = $skippable_script_for_target{$file})) { |
101 | my $reason = delete $other_requirement{$skippable_script}; | |
102 | diag("Note: $skippable_script must be run manually, because it $reason") | |
103 | if $reason; | |
5e39bfe1 | 104 | } |
c24c946d | 105 | } |
3879ea51 | 106 | |
0daf6d09 | 107 | foreach (@progs) { |
1fb364e9 | 108 | my $args = qq[-Ilib $_ --tap]; |
28cd6515 | 109 | note("./perl $args"); |
1fb364e9 | 110 | my $command = "$^X $args"; |
0daf6d09 | 111 | system $command |
1fb364e9 N |
112 | and die <<~"HINT"; |
113 | Hint: A failure in this file can often be corrected by running: | |
114 | ./perl -Ilib $_ | |
115 | HINT | |
bfc0a3e7 | 116 | } |