PennMUSH Community
Show
Ignore:
Timestamp:
10/05/07 15:36:32 (1 year ago)
Author:
shawnw
Message:

Merge with devel

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • 1.8.3/trunk/test/TestHarness.pm

    r439 r1117  
    11package TestHarness; 
     2use strict; 
     3use vars qw/%tests $testcount @failures $alltests $allfailures $allexpected/; 
     4use vars qw/$testfiles $use_mortal/; 
     5use subs qw/test summary/; 
    26 
    3 require Exporter; 
     7$alltests = 0; 
     8$allfailures = 0; 
     9$allexpected = 0; 
     10$testfiles = 0; 
     11$use_mortal = 0; 
    412 
    5 @ISA = qw(Exporter); 
     13sub new { 
     14    my $class = shift; 
     15    my $script = shift; 
     16    my %self = (  
     17        -expected => 0, 
     18        -depends => [], 
     19        -test => undef, 
     20    ); 
     21#    print "Looking at $script\n"; 
     22    $script =~ /^test(.*)\.pl$/o; 
     23    my $name = $1; 
     24    $self{-name} = $name; 
     25    warn "Duplicate test $name\n" if exists $tests{$name}; 
     26    my $code = 'sub { my $god = shift; ' . "\n"; 
     27    open IN, "<", $script or die "Couldn't open ${script}: $!\n"; 
     28    while (<IN>) { 
     29        chomp; 
     30        next if /^\s*(?:#|$)/o; 
     31        last if /^run tests:$/o; 
     32        if (/^depends on (.*)$/o) { 
     33            push @{$self{-depends}}, $1; 
     34        } 
     35        if (/^expect (\d+) failures!$/) { 
     36            $self{-expected} = $1; 
     37            print "Expecting $1 failures in $name\n"; 
     38        } 
     39        if (/^\s*login mortal$/) { 
     40            $code .= 'my $mortal = shift;' . "\n"; 
     41            $use_mortal = 1; 
     42        } 
     43    } 
     44    while (<IN>) { 
     45        $code .= $_; 
     46    } 
     47    close IN; 
     48    $code .= "}"; 
     49#    print "Test function for $name:\n$code\n"; 
     50    $self{-test} = eval $code; 
     51    my $obj = bless \%self; 
     52    $tests{$name} = $obj; 
     53    return $obj; 
     54} 
    655 
    7 @EXPORT = qw(test summary); 
     56sub run { 
     57    my $self = shift; 
     58    my $god = shift; 
     59    my $mortal = shift; 
     60    my ($failures, $test) = (0,0); 
    861 
    9 my $testcount = 0; 
    10 my @failures = (); 
     62    foreach my $dep (@{$self->{-depends}}) { 
     63        my $test = $tests{$dep}; 
     64        if (defined $test) { 
     65            $test->run($god, $mortal); 
     66        } else { 
     67            warn "Unresolved dependency $dep\n"; 
     68        } 
     69    } 
     70     
     71    local ($testcount, @failures) = (0, ()); 
     72 
     73    my $name = $self->{-name}; 
     74 
     75    print "Running tests for ${name}:\n"; 
     76 
     77    &{$self->{-test}}($god, $mortal); 
     78 
     79    $testfiles++; 
     80    $alltests += $testcount; 
     81    $allfailures += @failures; 
     82    $allexpected += $self->{-expected}; 
     83     
     84    summary $self->{-name}, $testcount, \@failures, $self->{-expected}; 
     85} 
     86 
     87END { 
     88    print "Totals:\n"; 
     89    summary("all tests run", $alltests, $allfailures, $allexpected) 
     90        if $testfiles > 1; 
     91} 
    1192 
    1293$| = 1; 
    …… 
    25106  my $verdict = 1; 
    26107 
    27   my $pattern; 
    28   foreach $pattern (@$patterns) { 
     108  foreach my $pattern (@$patterns) { 
    29109    my $matchpattern = $pattern; 
    30110    my $negate = 0; 
    …… 
    57137      print "  result:  $result\n"; 
    58138    } 
    59     foreach $pattern (@$patterns) { 
     139    foreach my $pattern (@$patterns) { 
    60140      print "  pattern: $pattern\n"; 
    61141    } 
    …… 
    65145 
    66146sub summary { 
    67   print ":"x70, "\n"; 
    68   print "\n"; 
    69   my $scount = $testcount - @failures; 
    70   my $fcount = @failures; 
    71   print "$testcount tests, $scount succeeded, $fcount failed\n"; 
    72   if ($fcount) { 
    73     print "failed tests:\n"; 
    74     my $str = join(", ", @failures); 
    75     while (length($str) > 67) { 
    76       $str =~ s/^(.{1,67}), //o; 
    77       print "  $1,\n"; 
     147    my ($name, $testcount, $failures, $expected) = @_; 
     148    print ":"x70, "\n"; 
     149    print "\n"; 
     150    my $fcount = 0; 
     151    if (ref $failures) { 
     152        $fcount = scalar @$failures; 
     153    } else { 
     154        $fcount = $failures; 
    78155    } 
    79     print "  $str\n"; 
    80   } 
    81  
    82   $testcount = 0; 
    83   @failures = (); 
    84 } 
    85  
    86 END { 
    87   summary() if $testcount; 
     156    my $scount = $testcount - $fcount; 
     157    print "$testcount tests, $scount succeeded, $fcount failed ($expected expected failures)\n"; 
     158    if ($fcount != $expected) { 
     159        print "failed tests:\n"; 
     160        my $str = join(", ", @$failures); 
     161        while (length($str) > 67) { 
     162            $str =~ s/^(.{1,67}), //o; 
     163            print "  $1,\n"; 
     164        } 
     165        print "  $str\n"; 
     166    } 
     167    print "\n"; 
    88168} 
    89169