view release on metacpan or  search on metacpan

lib/Test/Unit/Lite.pm  view on Meta::CPAN

use warnings;

our $VERSION = '0.1202';

use Carp ();
use File::Spec ();
use File::Basename ();
use File::Copy ();
use File::Path ();
use Symbol ();


# Can't use Exporter 'import'. Compatibility with Perl 5.6
use Exporter ();
BEGIN { *import = \&Exporter::import };
our @EXPORT = qw{ bundle all_tests };


# Copy this module to inc subdirectory of the source distribution
sub bundle {
    -f 'Makefile.PL' or -f 'Build.PL'
        or die "Cannot find Makefile.PL or Build.PL in current directory\n";

    my $src = __FILE__;
    my $dst = "inc/Test/Unit/Lite.pm";


    my @src = split m{/}, $src;
    my @dst = split m{/}, $dst;
    my $srcfile = File::Spec->catfile(@src);
    my $dstfile = File::Spec->catfile(@dst);

    die "Cannot bundle to itself: $srcfile\n" if $srcfile eq $dstfile;
    print "Copying $srcfile -> $dstfile\n";

    my $dstdir = File::Basename::dirname($dstfile);

    -d $dstdir or File::Path::mkpath([$dstdir], 0, oct(777) & ~umask);

    File::Copy::cp($srcfile, $dstfile) or die "Cannot copy $srcfile to $dstfile: $!\n";
}

sub all_tests {
    Test::Unit::TestRunner->new->start('Test::Unit::Lite::AllTests');
}


{
    package Test::Unit::TestCase;
    use Carp ();
    our $VERSION = $Test::Unit::Lite::VERSION;

    our %Seen_Refs = ();
    our @Data_Stack;
    my $DNE = bless [], 'Does::Not::Exist';

    sub new {
        my ($class) = @_;
        $class = ref $class if ref $class;
        my $self = {};
        return bless $self => $class;
    }

    sub set_up { }

    sub tear_down { }

    sub list_tests {
        my ($self) = @_;

        my $class = ref $self || $self;

        my @tests;

        my %seen_isa;
        my $list_base_tests;
        $list_base_tests = sub {
            my ($class) = @_;
            foreach my $isa (@{ *{ Symbol::qualify_to_ref("${class}::ISA") } }) {
                next unless $isa->isa(__PACKAGE__);
                $list_base_tests->($isa) unless $seen_isa{$isa};
                $seen_isa{$isa} = 1;
                push @tests, grep { /^test_/ } keys %{ *{ Symbol::qualify_to_ref("${class}::") } };
            };
        };
        $list_base_tests->($class);

        my %uniq_tests = map { $_ => 1 } @tests;
        @tests = sort keys %uniq_tests;

        return wantarray ? @tests : [ @tests ];
    }

    sub __croak {
        my ($default_message, $custom_message) = @_;
        $default_message = '' unless defined $default_message;
        $custom_message = '' unless defined $custom_message;
        my $n = 1;

        my ($file, $line) = (caller($n++))[1,2];
        my $caller;
        $n++ while (defined( $caller = caller($n) ) and not eval { $caller->isa('Test::Unit::TestSuite') });

        my $sub = (caller($n))[3] || '::';
        $sub =~ /^(.*)::([^:]*)$/;
        my ($test, $unit) = ($1, $2);

        my $message = "$file:$line - $test($unit)\n$default_message\n$custom_message";
        chomp $message;

        no warnings 'once';
        local $Carp::Internal{'Test::Unit::TestCase'} = 1;
        Carp::confess("$message\n");
    }

    sub fail {
        my ($self, $msg) = @_;
        $msg = '' unless defined $msg;
        __croak $msg;
    }