File Coverage

lib/Test/Classy.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	11	12	91.6
condition	3	3	100.0
subroutine	13	13	100.0
pod	2	2	100.0
total	84	85	98.8

package Test::Classy;

use strict;
use warnings;
use Test::More ();
use Test::Classy::Util;
use Sub::Install qw( install_sub );
use Class::Inspector;

our $VERSION = '0.11';

my @tests;
my $caller = caller;

install_sub({
  as   => 'load_tests_from',
  into => $caller,
  code => sub (@) {
    my @monikers = @_;

    require Module::Find;

    @tests = Test::Classy::_look_for_tests(@monikers);
    foreach my $moniker ( @monikers ) {
      push @tests, grep { $_->isa('Test::Classy::Base') }
                   Module::Find::useall( $moniker );
    }
  },
});

install_sub({
  as   => 'load_test',
  into => $caller,
  code => sub ($) {
    my $moniker = shift;
    unless (Class::Inspector->loaded($moniker)) {
      eval "require $moniker" or die $@;
    }
    push @tests, $moniker;
  },
});

install_sub({
  as   => 'limit_tests_by',
  into => $caller,
  code => sub (@) {
    my @monikers = @_;

    foreach my $class ( @tests ) {
      $class->_limit( @monikers );
    }
  },
});

install_sub({
  as   => 'run_tests',
  into => $caller,
  code => sub (;@) {
    my @args = @_;

    unless (@tests) {
      @tests = Test::Classy::_look_for_tests();
    }

    unless (Test::Classy::Util::_planned()) {
      Test::More::plan tests => __PACKAGE__->plan;
    }

    foreach my $class ( @tests ) {
      $class->_run_tests( @args );
    }
  },
});

sub _look_for_tests {
  my @queue = @_;

  unless (@queue) {
    @queue = grep { $_ ne 'main' }
             Class::Inspector->_subnames('');
  }

  my @found;
  while (my $moniker = shift @queue) {
    my @subnames = Class::Inspector->_subnames($moniker);
    foreach my $subname (@subnames) {
      my $class = $moniker.'::'.$subname;
      push @found, $class if $class ne 'Test::Classy::Base'
                         and $class->isa('Test::Classy::Base');
      unshift @queue, $class;
    }
  }
  return @found;
}

sub plan {
  my $plan = 0;
  foreach my $test ( @tests ) {
    $plan += $test->_plan;
  }
  return $plan;
}

sub reset { @tests = () }  # for test

1;

__END__