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 if ($^O eq 'dec_osf') {
  19     skip_all("$^O cannot handle this test");
  20 }
  21 use Config;
  22 if ( $Config{usecrosscompile} ) {
  23   skip_all( "Not all files are available during cross-compilation" );
  24 }
  25
  26 my $tests = 26; # I can't see a clean way to calculate this automatically.
  27
  28 my %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
  33 my @files = map {@$_} sort values %skip;
  34
  35 open my $fh, '<', 'regen.pl'
  36     or die "Can't open regen.pl: $!";
  37
  38 while (<$fh>) {
  39     last if /^__END__/;
  40 }
  41 die "Can't find __END__ in regen.pl"
  42     if eof $fh;
  43
  44 foreach (qw(embed_lib.pl regen_lib.pl uconfig_h.pl
  45             regcharclass_multi_char_folds.pl
  46             charset_translations.pl
  47             ),
  48          map {chomp $_; $_} <$fh>) {
  49     ++$skip{"regen/$_"};
  50 }
  51
  52 close $fh
  53     or die "Can't close regen.pl: $!";
  54
  55 my @progs = grep {!$skip{$_}} <regen/*.pl>;
  56 push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y);
  57
  58 plan (tests => $tests + @files + @progs);
  59
  60 OUTER: foreach my $file (@files) {
  61     open my $fh, '<', $file or die "Can't open $file: $!";
  62     1 while defined($_ = <$fh>) and !/Generated from:/;
  63     if (eof $fh) {
  64         fail("Can't find 'Generated from' line in $file");
  65         next;
  66     }
  67     my @bad;
  68     while (<$fh>) {
  69         last if /ex: set ro:/;
  70         unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) {
  71             chomp $_;
  72             fail("Bad line in $file: '$_'");
  73             next OUTER;
  74         }
  75         my $digest = digest($2);
  76         note("$digest $2");
  77         push @bad, $2 unless $digest eq $1;
  78     }
  79     is("@bad", '', "generated $file is up to date");
  80 }
  81
  82 foreach (@progs) {
  83     my $command = "$^X $_ --tap";
  84     system $command
  85         and die "Failed to run $command: $?";
  86 }