xref: /openbsd/gnu/usr.bin/perl/t/porting/utils.t (revision 3d61058a) 
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
50my @victims = (qw(installman installperl regen_perly.pl));
51my %excuses = (
52               'Porting/git-deltatool' => 'Git::Wrapper',
53               'Porting/podtidy' => 'Pod::Tidy',
54               'Porting/leakfinder.pl' => 'XS::APItest',
55              );
56
57foreach (@maybe) {
58    if (/\.p[lm]$/) {
59        push @victims, $_;
60    } else {
61        open $fh, '<', $_ or die "Can't open '$_': $!";
62        my $line = <$fh>;
63        if ($line =~ m{^#!(?:\S*|/usr/bin/env\s+)perl}
64	    || $^O eq 'VMS' && $line =~ m{^\$ perl}) {
65            push @victims, $_;
66        } else {
67            print "# $_ isn't a Perl script\n";
68        }
69    }
70}
71
72printf "1..%d\n", scalar @victims;
73
74# Does this perl have 64 bit integers?
75my $has_64bit_ints = eval { pack "Q", 1 };
76
77foreach my $victim (@victims) {
78 SKIP: {
79        skip ("$victim uses $excuses{$victim}, so can't test with just core modules")
80            if $excuses{$victim};
81
82        my $got = runperl(switches => ['-c'], progfile => $victim, stderr => 1, nolib => 1);
83
84        # check to see if this script needs 64 bit integers.
85        if (!$has_64bit_ints and $got =~ /requires 64 bit integers/) {
86            skip("$victim requires 64 bit integers and this is a 32 bit Perl", 1);
87        }
88
89        is($got, "$victim syntax OK\n", "$victim compiles")
90            or diag("when executing perl with '-c $victim'");
91    }
92}
93
94# ex: set ts=8 sts=4 sw=4 et:
95