File Coverage

blib/lib/Test/Ika.pm

Criterion	Covered	Total	%
statement	87	88	98.8
branch	8	10	80.0
condition			n/a
subroutine	28	29	96.5
pod	13	16	81.2
total	136	143	95.1

package Test::Ika;
use strict;
use warnings;
use 5.010001;
our $VERSION = '0.08';

use Module::Load;
use Test::Name::FromLine;

use Test::Ika::ExampleGroup;
use Test::Ika::Example;

use parent qw/Exporter/;

our @EXPORT = (qw(
    describe context it
    xdescribe xcontext xit
    when
    before_suite after_suite
    before_all after_all before_each after_each
    runtests
));


our $FINISHED;
our $ROOT = our $CURRENT = Test::Ika::ExampleGroup->new(name => 'root', root => 1);

our $REPORTER;
{
    my $module = $ENV{TEST_MAX_REPORTER};
    unless ($module) {
        $module = $ENV{HARNESS_ACTIVE} || $^O eq 'MSWin32' ? 'TAP' : 'Spec';
    }
    __PACKAGE__->set_reporter($module);
}

sub reporter { $REPORTER }

sub build_reporter_option {
    my $class = shift;
    return +{
        color => ! $ENV{TEST_IKA_NOCOLOR},
    };
}

sub set_reporter {
    my ($class, $module) = @_;
    $REPORTER = $class->load_reporter($module);
}

sub load_reporter {
    my ($class, $module) = @_;
    $module = ($module =~ s/^\+// ? $module : "Test::Ika::Reporter::$module");
    Module::Load::load($module);

    return $module->new(__PACKAGE__->build_reporter_option);
}

sub describe {
    my $code = ref $_[-1] eq 'CODE' ? pop : sub {};
    my ($name, $cond) = @_;

    my $current = $CURRENT;
    my $context = Test::Ika::ExampleGroup->new(
        name   => $name,
        parent => $current,
        cond   => $cond,
    );
    {
        local $CURRENT = $context;
        $code->();
    }
    $current->add_example_group($context);
}
*context = *describe;

sub when (&) {
    return $_[0];
}

sub it {
    my $code = ref $_[-1] eq 'CODE' ? pop : undef;
    my ($name, $cond) = @_;
    my $it = Test::Ika::Example->new(name => $name, code => $code, cond => $cond);
    $CURRENT->add_example($it);
}

sub xit {
    my $code = ref $_[-1] eq 'CODE' ? pop : undef;
    my ($name, $cond) = @_;
    my $it = Test::Ika::Example->new(name => $name, code => $code, cond => $cond, skip => 1);
    $CURRENT->add_example($it);
}

sub xdescribe {
    my $caller = caller(0);

    no strict 'refs';
    no warnings 'redefine';

    local *{"${caller}::it"} = \&xit;

    my $noop = sub {};
    local *{"${caller}::before_all"}  = $noop;
    local *{"${caller}::after_all"}   = $noop;
    local *{"${caller}::before_each"} = $noop;
    local *{"${caller}::after_each"}  = $noop;

    describe(@_);
}
*xcontext = \&xdescribe;

sub before_suite(&) {
    my $code = shift;
    $ROOT->add_trigger(before_all => $code);
}

sub after_suite(&) {
    my $code = shift;
    $ROOT->add_trigger(after_all => $code);
}

sub before_all(&) {
    my $code = shift;
    $CURRENT->add_trigger(before_all => $code);
}

sub after_all(&) {
    my $code = shift;
    $CURRENT->add_trigger(after_all => $code);
}

sub before_each(&) {
    my $code = shift;
    $CURRENT->add_trigger(before_each => $code);
}

sub after_each(&) {
    my $code = shift;
    $CURRENT->add_trigger(after_each => $code);
}

sub runtests {
    $ROOT->run();

    $FINISHED++;
    $REPORTER->finalize();
}

END {
    unless ($FINISHED) {
        runtests();
    }
}

1;
__END__