root/1.8.2/trunk/test/TestHarness.pm

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;