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 = 27; # 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/uconfig_h.h" => [qw(uconfig.h)], 35 "regen/mk_invlists.pl" => [qw(charclass_invlists.h uni_keywords.h)], 36 "regen/regcharclass.pl" => [qw(regcharclass.h)], 37 ); 38 39my %other_requirement = ( 40 "regen_perly.pl" => "requires bison", 41 "regen/keywords.pl" => "requires Devel::Tokenizer::C", 42 "regen/mk_invlists.pl" => "needs the Perl you've just built", 43 "regen/regcharclass.pl" => "needs the Perl you've just built", 44); 45 46my %skippable_script_for_target; 47for my $script (keys %other_requirement) { 48 $skippable_script_for_target{$_} = $script 49 for @{ $skip{$script} }; 50} 51 52my @files = map {@$_} sort values %skip; 53 54# find out what regen scripts would be executed by regen.pl which 55# is the script that implements `make regen`. We need to know this 56# because we will run regen.pl --tap, and it will in turn 57# so we don't need to execute the scripts it executes directly. 58my %regen_files; 59{ 60 open my $fh, '<', 'regen.pl' 61 or die "Can't open regen.pl: $!"; 62 63 while (<$fh>) { 64 last if /^__END__/; 65 } 66 die "Can't find __END__ in regen.pl" 67 if eof $fh; 68 while (<$fh>) { 69 chomp $_; 70 ++$regen_files{$_}; 71 } 72 close $fh 73 or die "Can't close regen.pl: $!"; 74} 75 76# This may look a bit weird but it makes sense. We build a skip hash of 77# all the scripts that we want to avoid executing /explicitly/ during 78# our tests. This includes the files listed in %regen_files because we 79# will execute them via regen.pl instead. 80foreach ( 81 qw( 82 charset_translations.pl 83 embed_lib.pl 84 mph.pl 85 regcharclass_multi_char_folds.pl 86 regen_lib.pl 87 sorted_types.pl 88 uconfig_h.pl 89 ), 90 keys %regen_files 91) { 92 ++$skip{"regen/$_"}; 93} 94 95 96my @progs = grep {!$skip{$_}} <regen/*.pl>; 97push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y); 98@progs = sort @progs; 99 100plan (tests => $tests + @files + @progs); 101 102OUTER: foreach my $file (@files) { 103 open my $fh, '<', $file or die "Can't open $file: $!"; 104 1 while defined($_ = <$fh>) and !/Generated from:/; 105 if (eof $fh) { 106 fail("Can't find 'Generated from' line in $file"); 107 next; 108 } 109 my @bad; 110 while (<$fh>) { 111 last if /ex:[^:]+:/; 112 unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) { 113 chomp $_; 114 fail("Bad line in $file: '$_'"); 115 next OUTER; 116 } 117 118 my $digest = digest($2); 119 note("$digest $2"); 120 push @bad, $2 unless $digest eq $1; 121 } 122 is("@bad", '', "generated $file is up to date"); 123 if (@bad && (my $skippable_script = $skippable_script_for_target{$file})) { 124 my $reason = delete $other_requirement{$skippable_script}; 125 diag("Note: $skippable_script must be run manually, because it $reason") 126 if $reason; 127 } 128} 129 130my @errors; 131foreach my $prog (@progs) { 132 my $args = qq[-Ilib $prog --tap]; 133 note("./perl $args"); 134 my $command = "$^X $args"; 135 if (system $command) { # if it exits with an error... 136 $command=~s/\s*--tap//; 137 push @errors, $prog eq "regen.pl" 138 ? "make regen" 139 : $command; 140 } 141} 142if ( @errors ) { 143 my $commands= join "\n", sort @errors; 144 die "\n\nERROR. There are generated files which are NOT up to date.\n", 145 "You should run the following commands to update these files:\n\n", 146 $commands, "\n\n", 147 "Once they are regenerated you should commit the changes.\n\n"; 148} 149