Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
Assertion	[ DIR ]	drwxr-xr-x
Runner	[ DIR ]	drwxr-xr-x
Assert.pm	20.71 KB	-rw-r--r--
Assertion.pm	1.98 KB	-rw-r--r--
Debug.pm	1.78 KB	-rw-r--r--
Decorator.pm	1.34 KB	-rw-r--r--
Error.pm	1.23 KB	-rw-r--r--
Exception.pm	1.75 KB	-rw-r--r--
Failure.pm	868 B	-rw-r--r--
HarnessUnit.pm	2.86 KB	-rw-r--r--
Listener.pm	2.01 KB	-rw-r--r--
Loader.pm	5.34 KB	-rw-r--r--
Procedural.pm	5.75 KB	-rw-r--r--
Result.pm	5.42 KB	-rw-r--r--
Runner.pm	1.93 KB	-rw-r--r--
Setup.pm	1.3 KB	-rw-r--r--
Test.pm	3.09 KB	-rw-r--r--
TestCase.pm	11.27 KB	-rw-r--r--
TestRunner.pm	5.64 KB	-rw-r--r--
TestSuite.pm	8.22 KB	-rw-r--r--
TkTestRunner.pm	18.07 KB	-rw-r--r--
Tutorial.pm	1.19 KB	-rw-r--r--
UnitHarness.pm	5.25 KB	-rw-r--r--
Warning.pm	783 B	-rw-r--r--

Code Editor : Test.pm

package Test::Unit::Test;
use strict;

use Carp;

use Test::Unit::Debug qw(debug);

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

sub count_test_cases {
    my $self = shift;
    my $class = ref($self);
    croak "call to abstract method ${class}::count_test_cases";
}

sub run {
    my $self = shift;
    my $class = ref($self);
    croak "call to abstract method ${class}::run";
}

sub name {
    my $self = shift;
    my $class = ref($self);
    croak "call to abstract method ${class}::name";
}

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

sub filter_method {
    my $self = shift;
    my ($token) = @_;

my $filtered = $self->filter->{$token};
    return unless $filtered;

if (ref $filtered eq 'ARRAY') {
        return grep $self->name eq $_, @$filtered;
    }
    elsif (ref $filtered eq 'CODE') {
        return $filtered->($self->name);
    }
    else {
        die "Didn't understand filtering definition for token $token in ",
            ref($self), "\n";
    }
}

my %filter = ();

sub filter { \%filter }

# use Attribute::Handlers;
    
# sub Filter : ATTR(CODE) {
#     my ($pkg, $symbol, $referent, $attr, $data, $phase) = @_;
#     print "attr $attr (data $data) on $pkg\::*{$symbol}{NAME}\n";
# #    return ();
# }

sub _find_sym { # pinched from Attribute::Handlers
    my ($pkg, $ref) = @_;
    my $type = ref($ref);
    no strict 'refs';
    warn "type $type\n";
    while (my ($name, $sym) = each %{$pkg."::"} ) {
        use Data::Dumper;
#        warn Dumper(*$sym);
        warn "name $name sym $sym (" . (*{$sym}{$type} || '?') . ") matches?\n";
        return \$sym if *{$sym}{$type} && *{$sym}{$type} == $ref;
    }
}

sub MODIFY_CODE_ATTRIBUTES {
    my ($pkg, $subref, @attrs) = @_;
    my @bad = ();
    foreach my $attr (@attrs) {
        if ($attr =~ /^Filter$(.*)$$/) {
            my @tokens = split /\s+|\s*,\s*/, $1;
            my $sym = _find_sym($pkg, $subref);
            if ($sym) {
                push @{ $filter{$_} }, *{$sym}{NAME} foreach @tokens;
            }
            else {
                warn "Couldn't find symbol for $subref in $pkg\n" unless $sym;
                push @bad, $attr;
            }
        }
        else {
            push @bad, $attr;
        }
    }
    return @bad;
}

1;
__END__

=head1 NAME

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

=head1 SYNOPSIS

This class is not intended to be used directly

=head1 DESCRIPTION

This class is used by the framework to define the interface of a test.
It is an abstract base class implemented by Test::Unit::TestCase and
Test::Unit::TestSuite.

Due to the nature of the Perl OO implementation, this class is not
really needed, but rather serves as documentation of the interface.

=head1 AUTHOR

Copyright (c) 2000-2002, 2005 the PerlUnit Development Team
(see L<Test::Unit> or the F<AUTHORS> file included in this
distribution).

=head1 SEE ALSO

=over 4

=item *

L<Test::Unit::Assert>

=item *

L<Test::Unit::TestCase>

=item *

L<Test::Unit::TestSuite>

=back

=cut

${this.title}

Code Editor : Test.pm