view release on metacpan or  search on metacpan

lib/Test/Spec.pm  view on Meta::CPAN

use parent 'Exporter';

use Carp ();
use Exporter ();
use File::Spec ();
use Tie::IxHash ();

use constant { DEFINITION_PHASE => 0, EXECUTION_PHASE => 1 };

our $TODO;
our $Debug = $ENV{TEST_SPEC_DEBUG} || 0;

our @EXPORT      = qw(runtests
                      describe xdescribe context xcontext it xit they xthey
                      before after around yield spec_helper
                      *TODO share shared_examples_for it_should_behave_like );
our @EXPORT_OK   = ( @EXPORT, qw(DEFINITION_PHASE EXECUTION_PHASE $Debug) );
our %EXPORT_TAGS = ( all => \@EXPORT_OK,
                     constants => [qw(DEFINITION_PHASE EXECUTION_PHASE)] );
our @CARP_NOT    = ();

our $_Current_Context;
our %_Package_Contexts;
our %_Package_Phase;
our %_Package_Tests;
our %_Shared_Example_Groups;
our $Yield = sub {
  local @CARP_NOT = qw( Test::Spec );
  Carp::croak "yield can be called only by around CODE";
};

# Avoid polluting the Spec namespace by loading these other modules into
# what's essentially a mixin class.  When you write "use Test::Spec",
# you'll get everything from Spec plus everything in ExportProxy. If you
# specify a list, the pool is limited to the stuff in @EXPORT_OK above.
{
  package Test::Spec::ExportProxy;
  use base qw(Exporter);
  BEGIN {
    eval "use Test::Deep 0.103 ()"; # check version and load export list
    Test::Deep->import(grep { $_ ne 'isa' } @Test::Deep::EXPORT);
  }
  use Test::More;
  use Test::Trap;
  use Test::Spec::Mocks;
  our @EXPORT_OK = (
    @Test::More::EXPORT,
    (grep { $_ ne 'isa' } @Test::Deep::EXPORT),
    qw(trap $trap),       # Test::Trap doesn't use Exporter
    @Test::Spec::Mocks::EXPORT,
  );
  our @EXPORT = @EXPORT_OK;
  our %EXPORT_TAGS = (all => \@EXPORT_OK);
}

sub import {
  my $class = shift;
  my $callpkg = caller;

  strict->import;
  warnings->import;

  # specific imports requested
  if (@_) {
    $class->export_to_level(1, $callpkg, @_);
    return;
  }

  eval qq{
    package $callpkg;
    use parent 'Test::Spec';
    # allow Test::Spec usage errors to be reported via Carp
    our \@CARP_NOT = qw($callpkg);
  };
  die $@ if $@;
  Test::Spec::ExportProxy->export_to_level(1, $callpkg);
  $class->export_to_level(1, $callpkg);
}

# PACKAGE->phase
# PACKAGE->phase(NEWPHASE)
sub phase {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  if (@_) {
    $_Package_Phase{$class} = shift;
  }
  if (exists $_Package_Phase{$class}) {
    return $_Package_Phase{$class};
  }
  else {
    return $_Package_Phase{$class} = DEFINITION_PHASE;
  }
}

# PACKAGE->add_test(SUBNAME)
sub add_test {
  my ($class,$test) = @_;
  my $list = $_Package_Tests{$class} ||= [];
  push @$list, $test;
  return;
}

# @subnames = PACKAGE->tests
sub tests {
  my ($class) = @_;
  my $list = $_Package_Tests{$class} ||= [];
  return @$list;
}

# runtests
# PACKAGE->runtests # @ARGV or $ENV{SPEC}
# PACKAGE->runtests(PATTERNS)
sub runtests {
  my $class = $_[0];
  if (not defined $class) {
    $class = caller;
  }
  elsif (not eval { $class->isa(__PACKAGE__) }) {
    $class = caller;