t/porting/utils.t

   1 #!./perl -w
   2
   3 # What does this test?
   4 # This checks that all the perl "utils" don't have embarrassing syntax errors
   5 #
   6 # Why do we test this?
   7 # Right now, without this, it's possible to pass the all the regression tests
   8 # even if one has introduced syntax errors into scripts such as installperl
   9 # or installman. No tests fail, so it's fair game to push the commit.
  10 # Obviously this breaks installing perl, but we won't spot this.
  11 # Whilst we can't easily test that the various scripts *work*, we can at least
  12 # check that we've not made any trivial screw ups.
  13 #
  14 # It's broken - how do I fix it?
  15 # Presumably it's failed because some (other) code that you changed was (also)
  16 # used by one of the utility scripts. So you'll have to manually test that
  17 # script.
  18
  19 BEGIN {
  20     @INC = '..' if -f '../TestInit.pm';
  21 }
  22 use TestInit qw(T); # T is chdir to the top level
  23 use strict;
  24
  25 require 't/test.pl';
  26
  27 # It turns out that, since the default @INC will include your old 5.x libs, if
  28 # you have them, the Porting utils might load a library that no longer compiles
  29 # clean.  This actually happened, with Local::Maketext::Lexicon from a 5.10.0
  30 # preventing 5.16.0-RC0 from testing successfully.  This test is really only
  31 # needed for porters, anyway.  -- rjbs, 2012-05-10
  32 find_git_or_skip('all');
  33
  34 my @maybe;
  35
  36 open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!";
  37 while (<$fh>) {
  38     push @maybe, $1 if m!^(Porting/\S+)!;
  39 }
  40 close $fh or die $!;
  41
  42 open $fh, '<', 'utils.lst' or die "Can't open utils.lst: $!";
  43 while (<$fh>) {
  44     die unless  m!^(\S+)!;
  45     push @maybe, $1;
  46     $maybe[$#maybe] .= '.com' if $^O eq 'VMS';
  47 }
  48 close $fh or die $!;
  49
  50 # regen/uconfig_h.pl is here because it's not possible to test it by running
  51 # it on non-*nix platforms, as it requires a Bourne shell. As it's the only file
  52 # in regen/ which we can syntax check but can't run, it's simpler to add it to
  53 # the list here, than copy-paste the entire syntax-checking logic to
  54 # t/porting/regen.t
  55 my @victims = (qw(installman installperl regen_perly.pl regen/uconfig_h.pl));
  56 my %excuses = (
  57                'Porting/git-deltatool' => 'Git::Wrapper',
  58                'Porting/podtidy' => 'Pod::Tidy',
  59                'Porting/leakfinder.pl' => 'XS::APItest',
  60               );
  61
  62 foreach (@maybe) {
  63     if (/\.p[lm]$/) {
  64         push @victims, $_;
  65     } else {
  66         open $fh, '<', $_ or die "Can't open '$_': $!";
  67         my $line = <$fh>;
  68         if ($line =~ m{^#!(?:\S*|/usr/bin/env\s+)perl}
  69             || $^O eq 'VMS' && $line =~ m{^\$ perl}) {
  70             push @victims, $_;
  71         } else {
  72             print "# $_ isn't a Perl script\n";
  73         }
  74     }
  75 }
  76
  77 printf "1..%d\n", scalar @victims;
  78
  79 foreach my $victim (@victims) {
  80  SKIP: {
  81         skip ("$victim uses $excuses{$victim}, so can't test with just core modules")
  82             if $excuses{$victim};
  83
  84         my $got = runperl(switches => ['-c'], progfile => $victim, stderr => 1, nolib => 1);
  85         is($got, "$victim syntax OK\n", "$victim compiles")
  86             or diag("when executing perl with '-c $victim'");
  87     }
  88 }
  89
  90 # ex: set ts=8 sts=4 sw=4 et: