| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091 |
- #!/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);
|