use.t 2.58 KB
Newer Older
1 2 3 4 5 6
#!/usr/bin/perl -w
use strict;

use Test::More;
use Getopt::Std;
use CPAN::Meta;
7
use File::Temp;
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

sub usage {
    my $exit = shift;
    $exit = 0 if !defined $exit;
    print "Usage: $0 [ Some::Module] ...\n";
    print "\tthe perl module is guessed from META.{json,yml} if not given as argument\n";
    exit $exit;
}

my %opts;
getopts('h', \%opts)
    or usage();

usage(0) if $opts{h};

sub getmodule {
24
    my $module;
25 26 27
    my $conffile = "debian/tests/pkg-perl/use-name";
    $conffile = "debian/tests/pkg-perl/module-name" if ! -e $conffile; # backcompat
    $conffile = "debian/tests/module-name" if ! -e $conffile; # backcompat squared
28 29 30 31 32 33 34 35 36

    $module = read_conffile($conffile);
    return $module if defined $module;
    return getmeta();
}

sub read_conffile {
    my $conffile = shift;
    my $ret;
37 38 39 40 41 42
    if ( -f $conffile ) {
        open(M, "<", $conffile)
            or BAIL_OUT("$conffile exists but can't be read");
        while (<M>) {
            chomp;
            next if /^\s*#/;
43
            /(\S+)/ and $ret = $1, last;
44
        }
Niko Tyni's avatar
Niko Tyni committed
45
        close M;
46 47
        BAIL_OUT("can't find anything in $conffile")
            if !defined $ret;
48
    }
49 50
    return $ret;
}
51

52
sub getmeta {
53 54 55 56 57 58 59 60 61
    my $meta;
    my $dist;
    eval { $meta = CPAN::Meta->load_file('META.json') };
    eval { $meta = CPAN::Meta->load_file('META.yml' ) } if !$meta;
    plan skip_all => "can't guess package from META.json or META.yml"
        if !$meta;

    $dist = $meta->name;

62
    my $module = $dist;
63 64 65 66 67 68 69 70 71 72 73 74 75
    $module =~ s,-,::,g;

    my $file = "$dist.pm";
    $file =~ s,-,/,g;

    my $basefile = $file;
    $basefile =~ s,.*/,,;

    ( -f $basefile ) or (-f "lib/$file") or plan skip_all => "$basefile or lib/$file not found";

    return $module;
}

76 77 78 79 80 81 82
sub getwhitelist {
    my $whitelist = 'debian/tests/pkg-perl/use-whitelist';
    my $ret;
    $ret = read_conffile($whitelist) if ( -f $whitelist );
    $ret;
}

83 84
my @modules = @ARGV ? @ARGV : getmodule();

85 86
my $whitelist = getwhitelist();

87 88
usage() if !@modules;

89
plan tests => 4 * scalar @modules;
90

91 92
# don't run the command in the source directory, in case
# cwd is on @INC
93 94 95 96 97 98 99

my $dir;
$dir = $ENV{'AUTOPKGTEST_TMP'};
$dir = $ENV{'ADTTMP'} if !defined $dir;
$dir = File::Temp::tempdir( CLEANUP => 1 ) if !defined $dir;

chdir($dir) or die("can't chdir to $dir");
100

101
for my $mod (@modules) {
102 103
  for my $envprefix ('', 'env PERL_DL_NONLAZY=1 ') {
    my $cmd = qq($envprefix $^X -w -M"$mod" -e 1 2>&1);
104 105 106
    my @out = qx($cmd);
    note(@out) if @out;
    ok(!$?, "$cmd exited successfully");
107 108
    @out = grep { !/$whitelist/ } @out if defined $whitelist;
    ok(!@out, "$cmd produced no (non-whitelisted) output");
109
  }
110
}