The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Unit::TestCase;
use strict;
use constant DEBUG => 0;

use base qw(Test::Unit::Test);

use Test::Unit::ExceptionFailure; 
use Test::Unit::ExceptionError; 
use Test::Unit::TestResult;

use vars '@ISA';

sub new {
    my $class = shift;
    my ($name) = @_;
    bless { _name => $name }, $class;
}

sub count_test_cases {
    my $self = shift;
    return 1;
}

sub create_result {
    my $self = shift;
    return Test::Unit::TestResult->new();
}

sub name {
    my $self = shift;
    return $self->{_name};
}

sub run {
    my $self = shift;
    print ref($self) . "::run() called\n" if DEBUG;
    my ($result) = @_;
    $result = create_result() unless defined($result);
    $result->run($self);
    return $result;
}

sub run_bare {
    my $self = shift;
    print ref($self) . "::run_bare() called\n" if DEBUG;
    $self->set_up();
    eval {
	$self->run_test();
    };
    my $exception = $@;
    $self->tear_down();
    if ($exception) {
	print ref($self) . "::run_bare() propagating exception\n" if DEBUG;
	if (!ref($exception) ||
	    ! eval {$exception->isa("Test::Unit::ExceptionFailure")} ) {
	    $exception = Test::Unit::ExceptionError->new($exception);
	}
	die $exception; # propagate exception
    }
}

sub run_test {
    my $self = shift; 
    print ref($self) . "::run_test() called\n" if DEBUG;
    my $method = $self->name();
    if ($self->can($method)) {
        $self->$method();
    } else {
        $self->fail("Method $method not found");
    }
}

sub set_up {
}

sub tear_down {
}

sub to_string {
    my $self = shift;
    my $class = ref($self);
    return $self->name() . "(" . $class . ")";
}

# Returns a list of the tests run by this class and its superclasses.
# DO NOT OVERRIDE THIS UNLESS YOU KNOW WHAT YOU ARE DOING!
sub list_tests {
    my $class = ref($_[0]) || $_[0];
    my @tests;
    no strict 'refs';
    if (defined(@{"$class\::TESTS"})) {
        push @tests, @{"$class\::TESTS"};
    }
    else {
        push @tests, grep { /^test/ && $class->can($_) }
            keys %{"$class\::"};
    }
    push @tests, map {$_->can('list_tests') ? $_->list_tests : ()}
        @{"$class\::ISA"};
    my %tests = map {$_ => ''} @tests if @tests;
    return keys %tests;
}

1;
__END__



=head1 NAME

Test::Unit::TestCase - unit testing framework base class

=head1 SYNOPSIS

    package FooBar;
    use base qw(Test::Unit::TestCase);

    sub new {
        my $self = shift()->SUPER::new(@_);
        # your state for fixture here
        return $self;
    }

    sub set_up {
        # provide fixture
    }
    sub tear_down {
        # clean up after test
    }
    sub test_foo {
        # test the foo feature
    }
    sub test_bar {
        # test the bar feature
    }

=head1 DESCRIPTION

(Taken from the JUnit TestCase class documentation)

A test case defines the "fixture" (resources need for testing) to run
multiple tests. To define a test case:

=over 4

=item 1

implement a subclass of TestCase

=item 2

define instance variables that store the state of the fixture

=item 3

initialize the fixture state by overriding C<set_up()>

=item 4

clean-up after a test by overriding C<tear_down()>.

=back

Each test runs in its own fixture so there can be no side
effects among test runs. Here is an example:

      package MathTest;
      use base qw(Test::Unit::TestCase);

      sub new {
	  my $self = shift()->SUPER::new(@_);
	  $self->{value_1} = 0;
	  $self->{value_2} = 0;
	  return $self;
      }

      sub set_up {
	  my $self = shift;
	  $self->{value_1} = 2;
	  $self->{value_2} = 3;
      }

For each test implement a method which interacts with the fixture.
Verify the expected results with assertions specified by calling
C<$self-E<gt>assert()> with a boolean value.

      sub test_add {
	  my $self = shift;
	  my $result = $self->{value_1} + $self->{value_2};
	  $self->assert($result == 5);
      }

Once the methods are defined you can run them. The normal way to do
this uses reflection to implement C<run_test>. It dynamically finds
and invokes a method. For this the name of the test case has to
correspond to the test method to be run. The tests to be run can be
collected into a TestSuite. The framework provides different test
runners, which can run a test suite and collect the results. A test
runner either expects a method C<suite()> as the entry point to get a
test to run or it will extract the suite automatically.

If you do not like the rather verbose backtrace that appears when a
test fails, you can use the C<quell_backtrace()> method. You will get
any message provided, but not the backtrace.

=head1 AUTHOR

Framework JUnit authored by Kent Beck and Erich Gamma.

Ported from Java to Perl by Christian Lemburg.

Copyright (c) 2000 Christian Lemburg, E<lt>lemburg@acm.orgE<gt>.

All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.

Thanks go to the other PerlUnit framework people: 
Brian Ewins, Cayte Lindner, J.E. Fritz, Zhon Johansen.

Thanks for patches go to:
Matthew Astley.

=head1 SEE ALSO

=over 4

=item *

L<Test::Unit::TestSuite>

=item *

L<Test::Unit::TestRunner>

=item *

L<Test::Unit::TkTestRunner>

=item *

For further examples, take a look at the framework self test
collection (Test::Unit::tests::AllTests).

=back

=cut