Bioperl-guts: Re: Been hacking again

Kate katel@worldpath.net
Sat, 14 Aug 1999 12:48:45 -0700


This is a multi-part message in MIME format.

------=_NextPart_000_0007_01BEE653.5876B040
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit

  Since you mentioned the need for a suite of tests, I'd like to mention a
tool, JUNIT, for unit testing.

( separate from functional testing ) at:
ftp://www.armaties.com/D/home/armaties/ftp/TestingFramework/JUnit/JUNIT21.ZI
P .

It has versions for VB and C++, but, unfortunately  not yet perl.

  I experimented with the results module, to see how it would play in perl.
It seems to be lumping arrays together.  If you have extra time to check it
out.

    I'm sold on the idea of test suites.  They will allow us to make changes
with confidence nothing is broken.

                                                           Kate






------=_NextPart_000_0007_01BEE653.5876B040
Content-Type: application/octet-stream;
	name="UnitTestResults.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
	filename="UnitTestResults.pm"

# UnitTestResults.pm
#
#
# MODIFICATION NOTES: See bottom of file.

# Copyright (c) 1999 Katharine Lindner
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

package Bio::UnitTests::UnitTestResults;

require 5.003;

use Carp;
use Bio::UnitTests::AssertionFailure;
require Exporter;
@ISA         = qw( Exporter);
@EXPORT      = qw();
## POD-formatted documentation

=head1 NAME

Bio::UnitTests::UnitTestResults - bioperl test failure object

=head1 SYNOPSIS

=head2 Object initialization

Bio::UnitTests::UnitTestResults->_initialize();
=cut
=head2 _initialize

 Title     : _initialize
 Usage     : Bio::UnitTests::UnitTestResults->_initialize();
 Function  : initialize a new object.
 Example   : See usage
 Returns   :
 Argument  :


=cut

sub _initialize
{

    my $self = shift;
    $self->{ 'failures' } = [];
    $self->{ 'errors' } = [];
    $self->{ 'warnings' } = [];
}

=head2 Object Creation

 $unit_test_results = Bio::UnitTests::UnitTestResults->new();
=cut
=head2 new

 Title     : new
 Usage     : $unit_test_results = Bio::UnitTests::UnitTestResults->new();
 Function  : The constructor for this class, returns a new object.
 Example   : See usage
 Returns   : Bio::UnitTests::UnitTestResults object
 Argument  :


=cut

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



sub new
{
    my $class = shift;
    my $self = {};
    bless $self, ref( $class ) || $class;
    $self->_initialize();
    return $self;
}

=head2 get_failures

 Title     : get_failures()
 Usage     :
 Function  : Return the list of assertion failures
           :
 Returns   : List of failures
 Argument  : None

=cut

sub get_failures
{
    my $self = shift;




 #may require disambiguation
    return @{$self->{ 'failures' } };
}

=head2 get_errors

 Title     : get_errors()
 Usage     :
 Function  : Return the list of errors
           :
 Returns   : List of errors
 Argument  : None

=cut

sub get_errors
{
    my $self = shift;




 #may require disambiguation
    return @{$self->{ 'errors' } };
}

=head2 get_warnings

 Title     : get_warnings()
 Usage     :
 Function  : Return the list of warnings
           :
 Returns   : List of warnings
 Argument  : None

=cut

sub get_warnings
{
    my $self = shift;




 #may require disambiguation
    return @{$self->{ 'warnings' } };
}

=head2 count_failures

 Title     : count_failures()
 Usage     :
 Function  : Returns the number of assertion failures
           :
 Returns   : number of failures
 Argument  : none

=cut

sub count_failures
{
    my $self = shift;

    return scalar @{ $self->get_failures };
}

=head2 count_errors

 Title     : count_errors()
 Usage     :
 Function  : Returns the number of errors
           :
 Returns   : number of errors
 Argument  : none

=cut
sub count_errors
{
    my $self = shift;

    return scalar @{ $self->get_errors };
}

=head2 count_warnings

 Title     : count_warnings()
 Usage     :
 Function  : Returns the number of warnings
           :
 Returns   : number of warnings
 Argument  : none

=cut
sub count_warnings
{
    my $self = shift;

    return scalar @{ $self->get_warnings };
}

=head2 add_failure

 Title     : add_failure()
 Usage     :
 Function  : Add a failure to the list of assertion failures
           :
 Returns   :
 Argument  : failure

=cut

sub add_failure
{
    my ( $self, $failure ) = @_;




    push @{ $self->get_failures }, ( $failure );
}

=head2 add_error

 Title     : add_error()
 Usage     :
 Function  : Add an error to the list of errors
           :
 Returns   :
 Argument  : error

=cut

sub add_error
{
    my ( $self, $error ) = @_;




    push @{ $self->get_errors }, ( $error );
}

=head2 add_warning

 Title     : add_warning()
 Usage     :
 Function  : Add a warning to the list of warnings
           :
 Returns   :
 Argument  : warning

=cut

sub add_warning
{
    my ( $self, $failure ) = @_;




    push @{ $self->get_warnings }, ( $warning );
}

=head2 was_successful

 Title     : was_successful()
 Usage     :
 Function  : Returns false if any failures or errors
           :
 Returns   :
 Argument  : none

=cut

sub was_successful
{
    my $self = shift;

    return  !{ $self->count_failures } and  !{ $self->count_errors };
}

=head2 print_failures

 Title     : print_failures()
 Usage     :
 Function  : Prints assertion failure messages
           :
 Returns   :
 Argument  : none

=cut
sub print_failures
{
    my $self = shift;
    my $failure;

    foreach $failure ( @{ $self->get_failures } )
    {
        $failure->print_message;
    }
}
=head2 print_errors

 Title     : print_errors()
 Usage     :
 Function  : Prints error messages
           :
 Returns   :
 Argument  : none

=cut
sub print_errors
{
    my $self = shift;
    my $error;

    foreach $error ( @{ $self->get_errors } )
    {
        print $error;
        print "\n";
    }
}
1;
__END__

------=_NextPart_000_0007_01BEE653.5876B040
Content-Type: application/octet-stream;
	name="TestUnitTestResults.pl"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="TestUnitTestResults.pl"

use lib '..\..';
use Bio::UnitTests::AssertionFailure();
use Bio::UnitTests::UnitTestResults();
use Bio::Root::Global qw(:std);
my $assertion_failure =3D Bio::UnitTests::AssertionFailure->new( =
"assertion failure" );
$assertion_failure->print_message();
my $test_results =3D Bio::UnitTests::UnitTestResults->new();
$test_results->add_failure( $assertion_failure );
$test_results->add_failure( Bio::UnitTests::AssertionFailure->new( =
"another failure" ) );
$test_results->add_failure( Bio::UnitTests::AssertionFailure->new( "yet =
another failure" ) );
print $test_results->count_failures();
print "\n";
$test_results->print_failures();
$test_results->add_error( "an error" );
$test_results->add_error( "another error" );
$test_results->add_error( "yet another error" );
$test_results->add_error( "last error" );
print $test_results->count_errors();
print "\n";
$test_results->print_errors();
print "Failures\n";
print $test_results->count_failures();
print "\n";
$test_results->print_failures();

------=_NextPart_000_0007_01BEE653.5876B040--

=========== Bioperl Project Mailing List Message Footer =======
Project URL: http://bio.perl.org
For info about how to (un)subscribe, where messages are archived, etc:
http://www.techfak.uni-bielefeld.de/bcd/Perl/Bio/vsns-bcd-perl-guts.html
====================================================================