Commit | Line | Data |
---|---|---|
48eabb99 NC |
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 | my @maybe; | |
28 | ||
29 | open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!"; | |
30 | while (<$fh>) { | |
31 | push @maybe, $1 if m!^(Porting/\S+)!; | |
32 | } | |
33 | close $fh or die $!; | |
34 | ||
35 | open $fh, '<', 'utils.lst' or die "Can't open utils.lst: $!"; | |
36 | while (<$fh>) { | |
37 | die unless m!^(\S+)!; | |
38 | push @maybe, $1; | |
238d2546 | 39 | $maybe[$#maybe] .= '.com' if $^O eq 'VMS'; |
48eabb99 NC |
40 | } |
41 | close $fh or die $!; | |
42 | ||
43 | my @victims = (qw(installman installperl regen_perly.pl)); | |
44 | my %excuses = ( | |
45 | 'Porting/git-deltatool' => 'Git::Wrapper', | |
46 | 'Porting/podtidy' => 'Pod::Tidy', | |
47 | ); | |
48 | ||
49 | foreach (@maybe) { | |
50 | if (/\.p[lm]$/) { | |
51 | push @victims, $_; | |
238d2546 | 52 | } elsif ($_ !~ m{^x2p/a2p}) { |
48eabb99 NC |
53 | # test_prep doesn't (yet) have a dependency on a2p, so it seems a bit |
54 | # silly adding one (and forcing it to be built) just so that we can open | |
55 | # it and determine that it's *not* a perl program, and hence of no | |
56 | # further interest to us. | |
57 | open $fh, '<', $_ or die "Can't open '$_': $!"; | |
58 | my $line = <$fh>; | |
238d2546 CB |
59 | if ($line =~ m{^#!(?:\S*|/usr/bin/env\s+)perl} |
60 | || $^O eq 'VMS' && $line =~ m{^\$ perl}) { | |
48eabb99 NC |
61 | push @victims, $_; |
62 | } else { | |
63 | print "# $_ isn't a Perl script\n"; | |
64 | } | |
65 | } | |
66 | } | |
67 | ||
68 | printf "1..%d\n", scalar @victims; | |
69 | ||
70 | foreach my $victim (@victims) { | |
71 | SKIP: { | |
72 | # Not clear to me *why* it needs the BEGIN block, given what it | |
73 | # does, but not in an easy position to change it. | |
74 | skip("$victim executes code in a BEGIN block which fails for empty \@ARGV") | |
238d2546 | 75 | if $victim =~ m{^utils/cpanp-run-perl}; |
48eabb99 NC |
76 | |
77 | skip ("$victim uses $excuses{$victim}, so can't test with just core modules") | |
78 | if $excuses{$victim}; | |
79 | ||
80 | my $got = runperl(switches => ['-c'], progfile => $victim, stderr => 1); | |
81 | is($got, "$victim syntax OK\n", "$victim compiles"); | |
82 | } | |
83 | } | |
84 | ||
85 | # Local variables: | |
86 | # cperl-indent-level: 4 | |
87 | # indent-tabs-mode: nil | |
88 | # End: | |
89 | # | |
90 | # ex: set ts=8 sts=4 sw=4 et: |