1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
#!/usr/bin/perl -w
use strict;
my $file = '../Cache';
unless (-f "$file.pm") {
open(CACHE,">$file.pm") or die "Cannot open cache";
print CACHE "package Cache;
require Exporter;
\@ISA=qw(Exporter);
\@EXPORT=qw();
1;
";
close CACHE;
}
use Helper;
my ($tstdir,$spath,$hostname,$httphost,$mailhost,$dnshost,$noserver,$nullhost,$quickcheck);
use Getopt::Long;
GetOptions
("tstdir:s"=>\$tstdir,
"spath:s"=>\$spath,
"hostname:s"=>\$hostname,
"httpname:s"=>\$httphost,
"mailhost:s"=>\$mailhost,
"dnshost:s"=>\$dnshost,
"noserver:s"=>\$noserver,
"nullhost:s"=>\$nullhost,
"quickcheck"=>\$quickcheck);
$spath = "." unless ($spath);
unless ($quickcheck) {
$hostname = get_option("hostname","host for FTP/UDP tests") unless ($hostname);
$httphost = get_option("httphost","host for HTTP tests") unless ($httphost);
$mailhost = get_option("mailhost","host for SMTP/IMAP/POP tests") unless ($mailhost);
$dnshost = get_option("dnshost","hostname to lookup for DNS tests") unless ($dnshost);
$noserver = get_option("noserver","host that rejects above services") unless ($noserver);
# This machine should not be locatable from your network. Use IP
# private addresses like 10.x.x.x and pick one that does not exist
# on your LAN/WAN
$nullhost = get_option("nullhost","nonexistent IP address (e.g., 10.0.0.0)") unless ($nullhost);
}
my @dots;
if (@ARGV) {
@dots = @ARGV;
} else {
unless ($tstdir) {
if (-d './t') {
$tstdir = './t';
} else {
$tstdir = $ENV{PWD};
$tstdir = `/bin/pwd` unless defined($tstdir);
chomp $tstdir;
if (defined($tstdir)) {
$tstdir =~ s|^(.*)/([^/]+)/?$|$1/$2|;
if (-d "../../$2/t") {
$tstdir = "../../$2/t";
} elsif (-d "$tstdir/t") {
$tstdir = "$tstdir/t";
}
} else {
die "Could not get PWD from environment\n";
}
}
}
$tstdir = './t' unless ($tstdir);
opendir(DIR, $tstdir) || die "can't opendir $tstdir: $!";
while ($file = readdir(DIR)) {
push @dots, "$tstdir/$file" if ($file =~ m/^[^\.]+\.t$/);
}
closedir DIR;
}
my $prog;
my $test;
my @progs;
foreach $test (@dots) {
$prog=`basename $test .t`;
chomp $prog;
if ( -e "$prog" ){
push @progs, "$test";
}else{
print "No binary found for $prog\n";
}
}
use Test::Harness;
#$Test::Harness::verbose=1;
runtests(@progs);
|