зеркало из https://github.com/mozilla/gecko-dev.git
96 строки
2.0 KiB
Perl
96 строки
2.0 KiB
Perl
#!/usr/bin/env perl
|
|
###########################################################################
|
|
## Intent:
|
|
## Test::Harness is a testing wrapper that will process output
|
|
## from Test.pm module tests. Sumarize results, report stats
|
|
## and exit with overall status for the testing suites.
|
|
##
|
|
## Run testing suite:
|
|
## % make clean test
|
|
## % perl runtest
|
|
##
|
|
## Run Individual tests
|
|
## % perl tUtils0
|
|
###########################################################################
|
|
|
|
##----------------------------##
|
|
##---] CORE/CPAN INCLUDES [---##
|
|
##----------------------------##
|
|
use strict;
|
|
use warnings;
|
|
use Getopt::Long;
|
|
|
|
use Test::Harness;
|
|
|
|
##-------------------##
|
|
##---] EXPORTS [---##
|
|
##-------------------##
|
|
our $VERSION = qw(1.0);
|
|
use FindBin;
|
|
|
|
##-------------------##
|
|
##---] GLOBALS [---##
|
|
##-------------------##
|
|
my %argv;
|
|
|
|
##----------------##
|
|
##---] MAIN [---##
|
|
##----------------##
|
|
unless(GetOptions(\%argv,
|
|
qw(debug|d)
|
|
))
|
|
{
|
|
print "Usage: $0\n";
|
|
print " --debug Enable debug mode\n";
|
|
exit 1;
|
|
}
|
|
|
|
if (2 > $Test::Harness::VERSION)
|
|
{
|
|
print "Unit tests will not be run, Test::Harness is too old\n"
|
|
if ($argv{debug});
|
|
exit 0;
|
|
}
|
|
|
|
|
|
my @tests;
|
|
|
|
########################################
|
|
## Gather a list of tests if none passed
|
|
########################################
|
|
unless (@tests = @ARGV)
|
|
{
|
|
local *D;
|
|
opendir(D, '.');
|
|
while($_ = readdir(D)) {
|
|
next unless /.t\S+$/;
|
|
next if (/\.ts$/);
|
|
push(@tests, $_);
|
|
}
|
|
closedir(D);
|
|
}
|
|
|
|
###############################################
|
|
## Glob a list of tests when directories passed
|
|
###############################################
|
|
my @tmp;
|
|
foreach (@tests)
|
|
{
|
|
local *D;
|
|
if (-d $_ && (my $dir = $_))
|
|
{
|
|
opendir(D, $_) || die "opendir(D) failed: $!";
|
|
my @tests = grep(/\.t[^\.\s]+/o, readdir(D));
|
|
closedir(D);
|
|
push(@tmp, map{ join('/', $dir, $_); } @tests);
|
|
} else {
|
|
push(@tmp, $_);
|
|
}
|
|
}
|
|
@tests = @tmp;
|
|
|
|
print "$0: @ARGV\n" if ($argv{debug});
|
|
runtests(@tests);
|
|
|
|
# EOF
|