[ID 20010210.002] perldiag doesn't include the "Scalars leaked" message

[p5sagit/p5-mst-13.2.git] / t / lib / test-harness.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
}


# For shutting up Test::Harness.
package My::Dev::Null;
use Tie::Handle;
@ISA = qw(Tie::StdHandle);

sub WRITE { }


package main;

# Utility testing functions.
my $test_num = 1;
sub ok ($;$) {
    my($test, $name) = @_;
    print "not " unless $test;
    print "ok $test_num";
    print " - $name" if defined $name;
    print "\n";
    $test_num++;
}

sub eqhash {
    my($a1, $a2) = @_;
    return 0 unless keys %$a1 == keys %$a2;

    my $ok = 1;
    foreach my $k (keys %$a1) {
        $ok = $a1->{$k} eq $a2->{$k};
        last unless $ok;
    }

    return $ok;
}


my $loaded;
BEGIN { $| = 1; $^W = 1; }
END {print "not ok $test_num\n" unless $loaded;}
print "1..$Total_tests\n";
use Test::Harness;
$loaded = 1;
ok(1, 'compile');
######################### End of black magic.

BEGIN {
    %samples = (
                simple            => {
                                      bonus      => 0,
                                      max        => 5,
                                      ok         => 5,
                                      files      => 1,
                                      bad        => 0,
                                      good       => 1,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 0,
                                     },
                simple_fail      => {
                                     bonus       => 0,
                                     max         => 5,
                                     ok          => 3,
                                     files       => 1,
                                     bad         => 1,
                                     good        => 0,
                                     tests       => 1,
                                     sub_skipped => 0,
                                     skipped     => 0,
                                    },
                descriptive       => {
                                      bonus      => 0,
                                      max        => 5,
                                      ok         => 5,
                                      files      => 1,
                                      bad        => 0,
                                      good       => 1,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 0,
                                     },
                no_nums           => {
                                      bonus      => 0,
                                      max        => 5,
                                      ok         => 4,
                                      files      => 1,
                                      bad        => 1,
                                      good       => 0,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 0,
                                     },
                todo              => {
                                      bonus      => 1,
                                      max        => 5,
                                      ok         => 5,
                                      files      => 1,
                                      bad        => 0,
                                      good       => 1,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 0,
                                     },
                skip              => {
                                      bonus      => 0,
                                      max        => 5,
                                      ok         => 5,
                                      files      => 1,
                                      bad        => 0,
                                      good       => 1,
                                      tests      => 1,
                                      sub_skipped=> 1,
                                      skipped    => 0,
                                     },
                bailout           => 0,
                combined          => {
                                      bonus      => 1,
                                      max        => 10,
                                      ok         => 8,
                                      files      => 1,
                                      bad        => 1,
                                      good       => 0,
                                      tests      => 1,
                                      sub_skipped=> 1,
                                      skipped    => 0
                                     },
                duplicates        => {
                                      bonus      => 0,
                                      max        => 10,
                                      ok         => 11,
                                      files      => 1,
                                      bad        => 1,
                                      good       => 0,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 0,
                                     },
                header_at_end     => {
                                      bonus      => 0,
                                      max        => 4,
                                      ok         => 4,
                                      files      => 1,
                                      bad        => 0,
                                      good       => 1,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 0,
                                     },
                skip_all          => {
                                      bonus      => 0,
                                      max        => 0,
                                      ok         => 0,
                                      files      => 1,
                                      bad        => 0,
                                      good       => 1,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 1,
                                     },
                with_comments     => {
                                      bonus      => 2,
                                      max        => 5,
                                      ok         => 5,
                                      files      => 1,
                                      bad        => 0,
                                      good       => 1,
                                      tests      => 1,
                                      sub_skipped=> 0,
                                      skipped    => 0,
                                     },
               );

    $Total_tests = keys(%samples) + 1;
}

tie *NULL, 'My::Dev::Null' or die $!;

while (my($test, $expect) = each %samples) {
    # _runtests() runs the tests but skips the formatting.
    my($totals, $failed);
    eval {
        select NULL;    # _runtests() isn't as quiet as it should be.
        ($totals, $failed) = 
          Test::Harness::_runtests("lib/sample-tests/$test");
    };
    select STDOUT;

    unless( $@ ) {
        ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), 
                                                                      $test );
    }
    else {      # special case for bailout
        ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
            $test );
    }
}