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 19BEGIN { 20 @INC = '..' if -f '../TestInit.pm'; 21} 22use TestInit qw(T); # T is chdir to the top level 23use strict; 24 25require './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 32find_git_or_skip('all'); 33 34my @maybe; 35 36open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!"; 37while (<$fh>) { 38 push @maybe, $1 if m!^(Porting/\S+)!; 39} 40close $fh or die $!; 41 42open $fh, '<', 'utils.lst' or die "Can't open utils.lst: $!"; 43while (<$fh>) { 44 die unless m!^(\S+)!; 45 push @maybe, $1; 46 $maybe[$#maybe] .= '.com' if $^O eq 'VMS'; 47} 48close $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 55my @victims = (qw(installman installperl regen_perly.pl regen/uconfig_h.pl)); 56my %excuses = ( 57 'Porting/git-deltatool' => 'Git::Wrapper', 58 'Porting/podtidy' => 'Pod::Tidy', 59 'Porting/leakfinder.pl' => 'XS::APItest', 60 ); 61 62foreach (@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 77printf "1..%d\n", scalar @victims; 78 79foreach 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: 91