package TestHarness; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(test summary); my $testcount = 0; my @failures = (); $| = 1; sub test { my $name = shift; my $conn = shift; my $command = shift; my $patterns = shift; $patterns = [$patterns] if ref($patterns) ne "ARRAY"; print substr("Running $name".(" "x80), 0, 78)."\r"; my $result = defined($command) ? $conn->command($command) : $conn->listen(); my $verdict = 1; my $pattern; foreach $pattern (@$patterns) { my $matchpattern = $pattern; my $negate = 0; if ($matchpattern =~ s/^!//o) { $negate = 1; } else { $matchpattern =~ s/^=//o; } if ($negate) { $verdict = 0 if $result =~ /$matchpattern/; } else { $verdict = 0 unless $result =~ /$matchpattern/; } } $testcount++; unless ($verdict) { push(@failures, $name); print "TEST FAILURE: $name\n"; if (defined($command)) { print " command: $command\n"; } else { print " listening\n"; } chomp $result; if ($result =~ /\n/o) { print " result:\n$result\n"; } else { print " result: $result\n"; } foreach $pattern (@$patterns) { print " pattern: $pattern\n"; } print "\n"; } } sub summary { print ":"x70, "\n"; print "\n"; my $scount = $testcount - @failures; my $fcount = @failures; print "$testcount tests, $scount succeeded, $fcount failed\n"; if ($fcount) { print "failed tests:\n"; my $str = join(", ", @failures); while (length($str) > 67) { $str =~ s/^(.{1,67}), //o; print " $1,\n"; } print " $str\n"; } $testcount = 0; @failures = (); } END { summary() if $testcount; } 1;