1#!./perl -w 2 3# Verify that all files generated by perl scripts are up to date. 4 5BEGIN { 6 @INC = '..' if -f '../TestInit.pm'; 7} 8use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute 9use strict; 10 11require 'regen/regen_lib.pl'; 12require 't/test.pl'; 13$::NO_ENDING = $::NO_ENDING = 1; 14 15if ( $^O eq "VMS" ) { 16 skip_all( "- regen.pl needs porting." ); 17} 18if ($^O eq 'dec_osf') { 19 skip_all("$^O cannot handle this test"); 20} 21use Config; 22if ( $Config{usecrosscompile} ) { 23 skip_all( "Not all files are available during cross-compilation" ); 24} 25 26my $tests = 25; # I can't see a clean way to calculate this automatically. 27 28my %skip = ("regen_perly.pl" => [qw(perly.act perly.h perly.tab)], 29 "regen/keywords.pl" => [qw(keywords.c keywords.h)], 30 "regen/uconfig_h.h" => [qw(uconfig.h)], 31 ); 32 33my @files = map {@$_} sort values %skip; 34 35open my $fh, '<', 'regen.pl' 36 or die "Can't open regen.pl: $!"; 37 38while (<$fh>) { 39 last if /^__END__/; 40} 41die "Can't find __END__ in regen.pl" 42 if eof $fh; 43 44foreach (qw(embed_lib.pl regen_lib.pl uconfig_h.pl 45 regcharclass_multi_char_folds.pl), 46 map {chomp $_; $_} <$fh>) { 47 ++$skip{"regen/$_"}; 48} 49 50close $fh 51 or die "Can't close regen.pl: $!"; 52 53my @progs = grep {!$skip{$_}} <regen/*.pl>; 54push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y); 55 56plan (tests => $tests + @files + @progs); 57 58OUTER: foreach my $file (@files) { 59 open my $fh, '<', $file or die "Can't open $file: $!"; 60 1 while defined($_ = <$fh>) and !/Generated from:/; 61 if (eof $fh) { 62 fail("Can't find 'Generated from' line in $file"); 63 next; 64 } 65 my @bad; 66 while (<$fh>) { 67 last if /ex: set ro:/; 68 unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) { 69 chomp $_; 70 fail("Bad line in $file: '$_'"); 71 next OUTER; 72 } 73 my $digest = digest($2); 74 note("$digest $2"); 75 push @bad, $2 unless $digest eq $1; 76 } 77 is("@bad", '', "generated $file is up to date"); 78} 79 80foreach (@progs) { 81 my $command = "$^X $_ --tap"; 82 system $command 83 and die "Failed to run $command: $?"; 84} 85