t/porting/regen.t

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