Skip to content

Commit

Permalink
extract test examples into separate objects to reduce the number of c…
Browse files Browse the repository at this point in the history 
…ircular references
  • Loading branch information
Andy Jones committed Apr 19, 2015
1 parent c8ce407 commit 294aff5
Show file tree
Hide file tree
Showing 4 changed files with 235 additions and 123 deletions.
39 changes: 21 additions & 18 deletions lib/Test/Spec.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,11 +26,10 @@ our %EXPORT_TAGS = ( all => \@EXPORT_OK,
constants => [qw(DEFINITION_PHASE EXECUTION_PHASE)] );

our $_Current_Context;
our $_Package_Contexts = _ixhash();
our %_Package_Contexts;
our %_Package_Phase;
our %_Package_Tests;

our $_Shared_Example_Groups = {};
our %_Shared_Example_Groups;

# Avoid polluting the Spec namespace by loading these other modules into
# what's essentially a mixin class. When you write "use Test::Spec",
Expand Down Expand Up @@ -128,7 +127,7 @@ sub runtests {
$class->_materialize_tests;
$class->phase(EXECUTION_PHASE);

my @which = @_ ? @_ :
my @which = @_ ? @_ :
$ENV{SPEC} ? ($ENV{SPEC}) : ();

return $class->_execute_tests( $class->_pick_tests(@which) );
Expand All @@ -143,17 +142,24 @@ sub _pick_tests {
my ($class,@matchers) = @_;
my @tests = $class->tests;
for my $pattern (@matchers) {
@tests = grep { $_ =~ /$pattern/i } @tests;
@tests = grep { $_->name =~ /$pattern/i } @tests;
}
return @tests;
}

sub _execute_tests {
my ($class,@tests) = @_;
for my $test (@tests) {
$class->can($test)->();
$test->run();
}

$class->builder->done_testing;

# given we just called done_testing above, we can't call runtests
# again so we can clean up any references here.
# We have quite a few circular deps to clean up!
# Ensure we don't keep any references to user variables so they go out of scope as expected
%_Package_Tests = %_Package_Contexts = ();
}

# it DESC => CODE
Expand Down Expand Up @@ -197,7 +203,7 @@ sub describe(@) {
$container = $_Current_Context->context_lookup;
}
else {
$container = $_Package_Contexts->{$package} ||= _ixhash();
$container = $_Package_Contexts{$package} ||= {};
}

__PACKAGE__->_accumulate_examples({
Expand Down Expand Up @@ -245,7 +251,7 @@ sub shared_examples_for($&) {
}

__PACKAGE__->_accumulate_examples({
container => $_Shared_Example_Groups,
container => \%_Shared_Example_Groups,
name => $name,
class => undef, # shared examples are global
code => $code,
Expand Down Expand Up @@ -282,12 +288,9 @@ sub _accumulate_examples {
}
}

# push a context onto the stack
local $_Current_Context = $context;

# evaluate the context function, which will set up lexical variables and
# define tests and other contexts
$context->contextualize($code);
$context->contextualize($code);
}

# it_should_behave_like DESC
Expand All @@ -299,7 +302,7 @@ sub it_should_behave_like($) {
if (!$_Current_Context) {
Carp::croak "it_should_behave_like can only be used inside a describe or shared_examples_for context";
}
my $context = $_Shared_Example_Groups->{$name} ||
my $context = $_Shared_Example_Groups{$name} ||
Carp::croak "unrecognized example group \"$name\"";

# make a copy so we can assign the correct class name (via parent),
Expand Down Expand Up @@ -380,7 +383,7 @@ sub share(\%) {

sub _materialize_tests {
my $class = shift;
my $contexts = $_Package_Contexts->{$class};
my $contexts = $_Package_Contexts{$class};
if (not $contexts && %$contexts) {
Carp::carp "no examples defined in spec package $class";
return;
Expand Down Expand Up @@ -414,7 +417,7 @@ sub _autovivify_context {
}
else {
my $name = ''; # unnamed context
return $_Package_Contexts->{$package}{$name} ||=
return $_Package_Contexts{$package}{$name} ||=
Test::Spec::Context->new({ name => $name, class => $package, parent => undef });
}
}
Expand All @@ -426,7 +429,7 @@ sub current_context {

sub contexts {
my ($class) = @_;
my @ctx = values %{ $_Package_Contexts->{$class} || {} };
my @ctx = values %{ $_Package_Contexts{$class} || {} };
return wantarray ? @ctx : \@ctx;
}

Expand Down Expand Up @@ -879,10 +882,10 @@ Consider the browsers example from C<shared_examples_for>. A real
browser specification would be large, so putting the specs for all
browsers in the same file would be a bad idea. So let's say we create
C<all_browsers.pl> for the shared examples, and give Safari and Firefox
C<safari.t> and C<firefox.t>, respectively.
C<safari.t> and C<firefox.t>, respectively.
The problem then becomes: how does the code in C<all_browsers.pl> access
the C<$browser> variable? In L<the example code|/shared_examples_for DESCRIPTION =E<gt> CODE>,
the C<$browser> variable? In L<the example code|/shared_examples_for DESCRIPTION =E<gt> CODE>,
C<$browser> is a lexical variable that is in scope for all the examples.
But once those examples are split into multiple files, you would have to
use either package global variables or worse, come up with some other
Expand Down
135 changes: 30 additions & 105 deletions lib/Test/Spec/Context.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,15 @@ use List::Util ();
use Scalar::Util ();
use Test::More ();
use Test::Spec qw(*TODO $Debug :constants);
use Test::Spec::Example;
use Test::Spec::TodoExample;

our $_StackDepth = 0;

sub new {
my $class = shift;
my $self = bless {}, $class;

if (@_) {
my $args = shift;
if (@_ || ref($args) ne 'HASH') {
Expand All @@ -27,17 +30,19 @@ sub new {
}
}

my $this = $self;
Scalar::Util::weaken($this);
$self->on_enter(sub {
$self->_debug(sub {
printf STDERR "%s[%s]\n", ' ' x $_StackDepth, $self->_debug_name;
$this && $this->_debug(sub {
printf STDERR "%s[%s]\n", ' ' x $_StackDepth, $this->_debug_name;
$_StackDepth++;
});
});

$self->on_leave(sub {
$self->_debug(sub {
$this && $this->_debug(sub {
$_StackDepth--;
printf STDERR "%s[/%s]\n", ' ' x $_StackDepth, $self->_debug_name;
printf STDERR "%s[/%s]\n", ' ' x $_StackDepth, $this->_debug_name;
});
});

Expand Down Expand Up @@ -283,109 +288,29 @@ sub _materialize_tests {
my $description = $self->_concat((map { $_->name } @context_stack), $t->{name});
my $test_number = 1 + scalar($self->class->tests);
my $sub_name = sprintf $format, $test_number, $self->_make_safe($description);
my $fq_name = $self->class . '::' . $sub_name;

# create a test subroutine in the correct package
no strict 'refs';
*{$fq_name} = sub {
if (!$t->{code} || $t->{todo}) {
my $builder = $self->_builder;
local $TODO = $t->{todo} || "(unimplemented)";
$builder->todo_start($TODO);
$builder->ok(1, $description);
$builder->todo_end();
}
else {
# copy these, because they'll be needed in a callback with its own @_
my @test_args = @_;

# clobber Test::Builder's ok() method just like Test::Class does,
# but without screwing up underscores.
no warnings 'redefine';
my $orig_builder_ok = \&Test::Builder::ok;
local *Test::Builder::ok = sub {
my ($builder,$test,$desc) = splice(@_,0,3);
$desc ||= $description;
local $Test::Builder::Level = $Test::Builder::Level+1;
$orig_builder_ok->($builder, $test, $desc, @_);
};

# This recursive closure essentially does this
# $outer->contextualize {
# $outer->before_each
# $inner->contextualize {
# $inner->before_each
# $anon->contextualize {
# $anon->before_each (no-op)
# execute test
# $anon->after_each (no-op)
# }
# $inner->after_each
# }
# $outer->after_each
# }
#
my $runner;
$runner = sub {
my ($ctx,@remainder) = @_;
$ctx->contextualize(sub {
$ctx->_run_before_all_once;
$ctx->_run_before('each');
if ($ctx == $self) {
$self->_in_anonymous_context(sub { $t->{code}->(@test_args) });
}
else {
$runner->(@remainder);
}
$ctx->_run_after('each');
# "after 'all'" only happens during context destruction (DEMOLISH).
# This is the only way I can think to make this work right
# in the case that only specific test methods are run.
# Otherwise, the global teardown would only happen when you
# happen to run the last test of the context.
});
};
eval { $runner->(@context_stack) };
if (my $err = $@) {
my $builder = $self->_builder;
# eval in case stringification overload croaks
chomp($err = eval { $err . '' } || 'unknown error');
my ($file,$line);
($file,$line) = ($1,$2) if ($err =~ s/ at (.+?) line (\d+)\.\Z//);

# disable ok()'s diagnostics so we can generate a custom TAP message
my $old_diag = $builder->no_diag;
$builder->no_diag(1);
# make sure we can restore no_diag
eval { $builder->ok(0, $description) };
my $secondary_err = $@;
# no_diag needs a defined value, so double-negate it to get either '' or 1
$builder->no_diag(!!$old_diag);

unless ($builder->no_diag) {
# emulate Test::Builder::ok's diagnostics, but with more details
my ($msg,$diag_fh);
if ($builder->in_todo) {
$msg = "Failed (TODO)";
$diag_fh = $builder->todo_output;
}
else {
$msg = "Failed";
$diag_fh = $builder->failure_output;
}
print {$diag_fh} "\n" if $ENV{HARNESS_ACTIVE};
print {$builder->failure_output} qq[# $msg test '$description' by dying:\n];
print {$builder->failure_output} qq[# $err\n];
print {$builder->failure_output} qq[# at $file line $line.\n] if defined($file);
}
die $secondary_err if $secondary_err;
}
}

$self->_debug(sub { print STDERR "\n" });
};

$self->class->add_test($sub_name);
my $example;
if (!$t->{code} || $t->{todo}) {
$example = Test::Spec::TodoExample->new({
name => $sub_name,
reason => $t->{tdoo},
description => $description,
builder => $self->_builder,
});
}
else {
$example = Test::Spec::Example->new({
name => $sub_name,
description => $description,
code => $t->{code},
# stack => \@context_stack,
context => $self,
builder => $self->_builder,
});
}

$self->class->add_test($example);
}

# recurse to child contexts
Expand Down
Loading

0 comments on commit 294aff5

Please sign in to comment.