File Coverage

blib/lib/Test/Flatten.pm

Criterion	Covered	Total	%
statement	92	110	83.6
branch	21	36	58.3
condition	7	9	77.7
subroutine	17	18	94.4
pod	1	1	100.0
total	138	174	79.3

package Test::Flatten;

use strict;
use warnings;
use Test::More ();
use Test::Builder ();
use Term::ANSIColor qw(colored);

our $VERSION = '0.11';

our $BORDER_COLOR  = [qw|cyan bold|];
our $BORDER_CHAR   = '-';
our $BORDER_LENGTH = 78;
our $CAPTION_COLOR = ['clear'];
our $NOTE_COLOR    = ['yellow'];

our $ORG_SUBTEST = Test::Builder->can('subtest');
our $ORG_TEST_MORE_SUBTEST = Test::More->can('subtest');

$ENV{ANSI_COLORS_DISABLED} = 1 if $^O eq 'MSWin32';

sub import {
    my $class = caller(0);
    no warnings qw(redefine prototype);
    no strict 'refs';
    *Test::Builder::subtest = \&subtest;

    # backward campatibility
    *{"$class\::subtest"} = Test::More->can('subtest');
}

my $TEST_DIFF = 0;
END {
    if ($TEST_DIFF) {
        my $builder = Test::More->builder;
        _diag_plan($builder->{Curr_Test} - $TEST_DIFF, $builder->{Curr_Test});
        Test::Builder::_my_exit(255); # report fail
        undef $Test::Builder::Test;   # disabled original END{} block
    }
}

sub subtest {
    my ($self, $caption, $test, @args) = @_;

    my $builder = Test::More->builder;
    unless (ref $test eq 'CODE') {
        $builder->croak("subtest()'s second argument must be a code ref");
    }

    # copying original setting
    my $current_test = $builder->{Curr_Test};
    my $skip_all     = $builder->{Skip_All};
    my $have_plan    = $builder->{Have_Plan};
    my $no_plan      = $builder->{No_Plan};
    my $in_filter    = $builder->{__in_filter__};

    ## this idea from http://d.hatena.ne.jp/tokuhirom/20111017/1318831330
    if (my $filter  = $ENV{SUBTEST_FILTER}) {
        if ($caption =~ qr{$filter} || $in_filter) {
            $builder->{__in_filter__} = 1;
        }
        else {
            $builder->note(colored $NOTE_COLOR, "SKIP: $caption by SUBTEST_FILTER");
            return;
        }
    }

    $builder->note(colored $BORDER_COLOR, $BORDER_CHAR x $BORDER_LENGTH);
    $builder->note(colored $CAPTION_COLOR, $caption);
    $builder->note(colored $BORDER_COLOR, $BORDER_CHAR x $BORDER_LENGTH);

    # reset
    $builder->{Have_Plan} = 0;

    no warnings 'redefine';
    no strict 'refs';
    local *{ref($builder).'::plan'} = _fake_plan(\my $tests, \my $is_skip_all);
    local *{ref($builder).'::done_testing'} = sub {}; # temporary disabled

    use warnings;
    use strict;

    local $Test::Builder::Level = $Test::Builder::Level = 1;
    my $is_passing = eval { $test->(@args); 1 };
    my $e = $@;

    die $e if $e && !eval { $e->isa('Test::Builder::Exception') };

    if ($is_skip_all) {
        $builder->{Skip_All} = $skip_all;
    }
    elsif ($tests && $builder->{Curr_Test} != $current_test + $tests) {
        _diag_plan($tests, $builder->{Curr_Test} - $current_test);
        $TEST_DIFF = $builder->{Curr_Test} - $current_test - $tests;
        $is_passing = $builder->is_passing(0);
    }
    elsif ($builder->{Curr_Test} == $current_test) {
        $builder->croak("No tests run for subtest $caption");
    }

    # restore
    $builder->{Have_Plan}     = $have_plan;
    $builder->{No_Plan}       = $no_plan;
    $builder->{__in_filter__} = $in_filter;

    return $is_passing;
}

sub _diag_plan {
    my ($plan, $ran) = @_;
    my $s = $plan == 1 ? '' : 's';
    Test::More->builder->diag(sprintf 'Looks like you planned %d test%s but ran %d.',
        $plan, $s, $ran,
    );
}

sub _fake_plan {
    my ($tests, $is_skip_all) = @_;

    return sub {
        my ($self, $cmd, $arg) = @_;
        return unless $cmd;
        local $Test::Builder::Level = $Test::Builder::Level + 2;
        $self->croak("You tried to plan twice") if $self->{Have_Plan};

        if ($cmd eq 'no_plan') {
            local $Test::Builder::Level = $Test::Builder::Level + 1;
            $self->no_plan($arg);
        }
        elsif ($cmd eq 'skip_all') {
            local $Test::Builder::Level = $Test::Builder::Level + 1;
            $self->{Skip_All} = 1;
            $self->note(join q{ }, 'SKIP:', $arg) unless $self->no_header;
            $$is_skip_all = 1; # set flag
            die bless {}, 'Test::Builder::Exception';
        }
        elsif ($cmd eq 'tests') {
            if($arg) {
                local $Test::Builder::Level = $Test::Builder::Level + 1;
                unless ($arg =~ /^\+?\d+$/) {
                    $self->croak("Number of tests must be a positive integer.  You gave it '$arg'");
                }
                $$tests = $arg; # set tests
            }
            elsif( !defined $arg ) {
                $self->croak("Got an undefined number of tests");
            }
            else {
                $self->croak("You said to run 0 tests");
            }
        }
        else {
            my @args = grep { defined } ( $cmd, $arg );
            $self->croak("plan() doesn't understand @args");
        }
        return 1;
    };
}

1;
__END__