File Coverage

blib/lib/Test/Block.pm

Criterion	Covered	Total	%
statement	56	56	100.0
branch	16	16	100.0
condition	6	6	100.0
subroutine	17	17	100.0
pod	5	5	100.0
total	100	100	100.0

#! /usr/bin/perl

use strict;
use warnings;

package Test::Block;
use base qw(Exporter);

our @EXPORT_OK = qw($Plan);

use Carp;
use Test::Builder;
use Scalar::Util qw( looks_like_number );
use overload
    q{""} => \&remaining,
    q{0+} => \&remaining,
    fallback => 1;

our $VERSION = '0.13';

my $Last_test_in_previous_block = 0;
my $Active_block_count = 0;

my $Test_builder = Test::Builder->new;
sub builder { $Test_builder };

my $Block_count = 0;
sub block_count { $Block_count };

sub plan {
    my $class = shift;
    my ($expected_tests, $name) = (pop, pop);
    croak "need expected number of tests"
        unless $expected_tests && $expected_tests =~ /^\d+$/s;
    $Block_count++;
    $Active_block_count++;
    return bless {
        name            => defined $name ? $name : $Block_count,
        expected_tests  => $expected_tests,
        initial_test    => $Test_builder->current_test,
    }, $class;
}

sub _tests_run_in_block {
    my $self = shift;
    return $Test_builder->current_test - $self->{initial_test}
}

sub remaining {
    my $self = shift;
    return $self->{expected_tests} - _tests_run_in_block($self);
}

sub DESTROY {
    my $self = shift;
    $Active_block_count--;
    $Last_test_in_previous_block = $Test_builder->current_test;
    my $expected = $self->{expected_tests};
    my $name = $self->{name};
    my $tests_ran = _tests_run_in_block($self);
    $name = "'$name'" unless looks_like_number( $name );
    $Test_builder->ok(
        0,
        "block $name expected $expected test(s) and ran $tests_ran"
    ) unless $tests_ran == $expected;
}


my $All_tests_in_block = 1;
sub all_in_block {
    return unless $All_tests_in_block;
    return 1 if $Active_block_count > 0;
    $All_tests_in_block =
        $Last_test_in_previous_block == $Test_builder->current_test;
    return $All_tests_in_block
}


{
    package Test::Block::Plan;
    use Tie::Scalar;
    use base qw(Tie::StdScalar);

    sub STORE {
        my ($self, $plan) = @_;
        if ( defined($plan) && ! eval { $plan->isa( 'Test::Block' ) } ) {
            $plan = Test::Block->plan( ref($plan) ? %$plan : $plan );
        };
        $self->SUPER::STORE($plan);
    }
}

our $Plan;
tie $Plan, 'Test::Block::Plan';

1;
__END__