File Coverage

blib/lib/Wetware/Test/Suite.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch			n/a
condition			n/a
subroutine	13	13	100.0
pod	5	5	100.0
total	57	57	100.0

#-------------------------------------------------------------------------------
#      $URL$
#     $Date$
#   $Author$
# $Revision$
#-------------------------------------------------------------------------------
package Wetware::Test::Suite;

use strict;
use warnings;

use Carp;
use Test::More;

use Wetware::Test::Class;
use base q{Wetware::Test::Class};

our $VERSION = 0.04;

#-----------------------------------------------------------------------------

sub class_under_test { Carp::confess('Must override in sub-class.') }

#-----------------------------------------------------------------------------
# STOP!!!! DO NOT LOAD ANY tests into this Class! Since This Class
# has the exception that will be THROWN IF class_under_test() is
# called, and the 'Test()' will force the call to _apply_handler_AH_()
# in Attributes::Handlers....
#
# Wished i could find a simpler way. But, that gave me the idea for
# doing the Wetare::Test::CreateTestSuite
#
# REPEAT! This is a problem with the 'use thing that inherits this'
# it is not a problem with the calling 'code'
#
# sub test_new : Test(1) {
#     my $self           = shift;
#     my $object         = $self->object_under_test();
#     my $expected_class = $self->class_under_test();
#
#     Test::More::isa_ok( $object, $expected_class );
#     return $self;
# }

#-----------------------------------------------------------------------------

sub set_up : Test(setup) {
    my ($self, %params)  = @_;
    $self->new_object_under_test_for(%params);
    return $self;
}
#-----------------------------------------------------------------------------

sub new_object_under_test_for {
    my ($self, %params)  = @_;
    my $class = $self->class_under_test();
    $self->{$class} = $class->new(%params);
    return $self->{$class};
}
#-----------------------------------------------------------------------------

sub object_under_test {
    my $self  = shift;
    my $class = $self->class_under_test();
    return $self->{$class};
}
#-----------------------------------------------------------------------------

sub tear_down : Test(teardown) {
    my $self = shift;
    my $class = $self->class_under_test();
    delete $self->{$class}; # the $class needs to be deleted from $self.
    return $self;
}
#-------------------------------------------------------------------------------

1;

__END__