Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Swith over to not storing test events.

Things which are needed:
1) A way to turn on storage in
   use Test::More
   Test::Builder->create
2) Better docs about how to use (or not use) Test::Builder->results, events and
   Test::More summary and details.

For #198
  • Loading branch information...
commit b1aa7068d026ddd231da396fe066fc965ad95cb5 1 parent adc2c55
Michael G. Schwern schwern authored
7 Changes
View
@@ -9,6 +9,13 @@ See README and version control log for Test::Builder2 changes.
* Update the resources meta data to point at the correct repository, issues
mailing list and home page.
+ Incompatible Changes
+ * The result of each test is no longer stored by default. This keeps
+ the test framework from consuming more and more memory as tests are
+ run. Test::Builder->details and Test::Builder->summary will throw
+ exceptions by default. For most needs, they are replaced with
+ statistical methods in TB2::History. [github 198]
+
1.005000_005 Thu Apr 26 15:23:25 PDT 2012
New Features
4 examples/TB2/lib/TB2/NoWarnings.pm
View
@@ -79,10 +79,12 @@ plan is already set, but it doesn't.
sub handle_test_end {
my $self = shift;
+ $DB::single = 1;
+
my $warnings = $self->warnings_seen;
$self->builder
- ->ok( scalar @$warnings, "no warnings" )
+ ->ok( !scalar @$warnings, "no warnings" )
->diag([
warnings => $warnings
]);
12 lib/TB2/History.pm
View
@@ -73,14 +73,14 @@ to grow over the life of the test.
If false, $history will discard events and only keep a summary of
events. L<events> and L<results> will throw an exception if called.
-Defaults to true (which will change in a moment).
+Defaults to false, events are not stored by default.
=cut
has store_events =>
is => 'ro',
isa => 'Bool',
- default => 1
+ default => 0
;
@@ -225,7 +225,8 @@ sub subtest_handler {
my $event = shift;
my $subhistory = $self->new(
- subtest => $event,
+ subtest => $event,
+ store_events => $self->store_events
);
return $subhistory;
@@ -257,6 +258,8 @@ sub handle_result {
my $self = shift;
my $result = shift;
+ $DB::single = 1;
+
$self->result_count( $self->result_count + 1 );
$self->counter( $self->counter + 1 );
$self->_update_statistics($result);
@@ -658,6 +661,9 @@ sub consume {
croak 'consume() only takes History objects'
unless eval { $old_history->isa("TB2::History") };
+ croak 'Cannot consume() a History object which has store_events() off'
+ unless eval { $old_history->store_events };
+
$self->accept_event($_) for @{ $old_history->events };
return;
1  lib/TB2/Tester.pm
View
@@ -68,6 +68,7 @@ sub capture(&) {
my $our_ec = $state->push_coordinator;
$our_ec->clear_formatters;
+ $our_ec->history( TB2::History->new( store_events => 1 ) );
my($ret, $err) = $CLASS->try(sub { $code->(); 1; });
18 lib/Test/Builder.pm
View
@@ -1741,10 +1741,10 @@ sub current_test {
return $history->counter unless defined $num;
# If the test counter is being pushed forward fill in the details.
- my $results = $history->results;
+ my $result_count = $history->result_count;
- if ( $num > @$results ) {
- my $last_test_number = @$results ? @$results : 0;
+ if ( $num > $result_count ) {
+ my $last_test_number = $result_count ? $result_count : 0;
$history->counter($last_test_number);
for my $test_number ( $last_test_number + 1 .. $num ) {
@@ -1759,8 +1759,8 @@ sub current_test {
}
}
# If backward, wipe history. Its their funeral.
- elsif ( $num < @$results ) {
- $#{$results} = $num - 1;
+ elsif ( $num < $result_count ) {
+ $history->result_count($num);
}
$history->counter($num);
@@ -1801,6 +1801,9 @@ This is a logical pass/fail, so todos are passes.
Of course, test #1 is $tests[0], etc...
+By default, this method will throw an exception unless Test::Builder has
+been configured to store events.
+
=cut
sub summary {
@@ -1870,6 +1873,9 @@ result in this structure:
reason => 'insufficient donuts'
};
+By default, this test will throw an exception unless Test::Builder has
+been configured to store events.
+
=cut
sub details {
@@ -2149,7 +2155,7 @@ sub _sanity_check {
my $self = shift;
$self->_whoa( $self->current_test < 0, 'Says here you ran a negative number of tests!' );
- $self->_whoa( $self->current_test != @{ $self->history->results },
+ $self->_whoa( $self->current_test != $self->history->result_count,
'Somehow you got a different number of results than tests ran!' );
return;
4 t/Builder/context.t
View
@@ -9,14 +9,16 @@ use lib 't/lib';
BEGIN { require "t/test.pl" }
use Test::Builder::NoOutput;
+use TB2::History;
my $tb = Test::Builder::NoOutput->create;
+my $history = TB2::History->new( store_events => 1 );
+$tb->test_state->ec->history($history);
my $from_idx = 0;
sub check_events {
my($tb, $line) = @_;
- my $results = $tb->history->results;
my $events = $tb->history->events;
my @have = @{$events}[ $from_idx .. $#{$events} ];
10 t/Builder/current_test/test_number.t
View
@@ -3,8 +3,16 @@
# Test that current_test will get the numbering right if no tests
# have yet been run by Test::Builder.
+use strict;
+use warnings;
+
use Test::Builder;
-$TB = Test::Builder->new;
+use TB2::History;
+
+my $TB = Test::Builder->new;
+my $history = TB2::History->new( store_events => 1 );
+$TB->test_state->ec->history($history);
+
$TB->no_header(1);
print "ok 1\n";
print "ok 2\n";
8 t/Builder/details.t
View
@@ -7,7 +7,11 @@ use lib 't/lib';
use Test::More;
use Test::Builder;
+use TB2::History;
+
my $Test = Test::Builder->new;
+my $history = TB2::History->new( store_events => 1 );
+$Test->test_state->ec->history($history);
$Test->plan( tests => 9 );
$Test->level(0);
@@ -91,7 +95,9 @@ is_deeply( \@details, \@Expected_Details );
# This test has to come last because it thrashes the test details.
-{
+TODO_SKIP: {
+ local $TODO = "current_test() going backwards is broken and may be removed";
+
my $curr_test = $Test->current_test;
$Test->current_test(4);
my @details = $Test->details();
5 t/Builder/reset.t
View
@@ -14,6 +14,7 @@ chdir 't';
use Test::Builder;
+use TB2::History;
my $Test = Test::Builder->new;
my $tb = Test::Builder->create;
@@ -57,8 +58,8 @@ $Test->ok( $tb->use_numbers, , 'use_numbers' );
$Test->ok( !$tb->no_header, , 'no_header' );
$Test->ok( !$tb->no_ending, , 'no_ending' );
$Test->is_num( $tb->current_test, 0, 'current_test' );
-$Test->is_num( scalar $tb->summary, 0, 'summary' );
-$Test->is_num( scalar $tb->details, 0, 'details' );
+$Test->is_num( $tb->history->event_count, 0 );
+$Test->is_num( $tb->history->result_count, 0 );
$Test->is_eq( fileno $tb->output,
fileno $Original_Output{output}, 'output' );
$Test->is_eq( fileno $tb->failure_output,
5 t/Builder2/NoWarnings.t
View
@@ -33,9 +33,10 @@ BEGIN { require "t/test.pl" }
# Test the result
- plan tests => 2;
+ plan tests => 3;
# qr/...$/m is broken on Debian etch's 5.8.8
like $builder->formatter->streamer->read("out"), qr/^1\.\.3\n/m, "count correct";
- ok $builder->history->results->[2], "no warnings test failed properly";
+ is $builder->history->result_count, 3, "no warnings test ran";
+ is $builder->history->fail_count, 1, "no warnings test failed properly";
}
6 t/Builder2/context.t
View
@@ -6,9 +6,13 @@ use warnings;
BEGIN { require 't/test.pl' }
use Test::Builder2;
+use TB2::History;
+
my $tb = Test::Builder2->create;
$tb->test_state->clear_formatters;
-
+$tb->test_state->ec->history(
+ TB2::History->new( store_events => 1 )
+);
my $from_idx = 0;
sub check_events {
5 t/Builder2/ok_starts_a_stream.t
View
@@ -12,10 +12,7 @@ my $tb = Test::Builder2->default;
# ok() starts the stream automatically
{
$tb->ok(1);
-
- my $history = $tb->history;
- my $start = grep { $_->event_type eq 'test_start' } @{$history->events};
- $tb->ok( $start, "ok issued a test_start" );
+ $tb->ok( $tb->history->in_test, "ok issued a test_start" );
}
$tb->set_plan( no_plan => 1 );
15 t/Event/TestState.t
View
@@ -22,8 +22,10 @@ note "new() does not work"; {
note "create() and pass through"; {
+ require TB2::History;
my $state = $CLASS->create(
- formatters => []
+ formatters => [],
+ history => TB2::History->new( store_events => 1 )
);
is_deeply $state->formatters, [], "create() passes arguments through";
@@ -94,7 +96,8 @@ note "popping the last coordinator"; {
note "basic subtest"; {
my $state = $CLASS->create(
- formatters => []
+ formatters => [],
+ history => TB2::History->new( store_events => 1 )
);
note "...starting a subtest";
@@ -133,7 +136,8 @@ note "basic subtest"; {
note "honor event presets"; {
my $state = $CLASS->create(
- formatters => []
+ formatters => [],
+ history => TB2::History->new( store_events => 1 )
);
note "...post a subtest with a pre defined depth";
@@ -156,7 +160,8 @@ note "honor event presets"; {
note "nested subtests"; {
my $state = $CLASS->create(
- formatters => []
+ formatters => [],
+ history => TB2::History->new( store_events => 1 )
);
my $first_stream_start = TB2::Event::TestStart->new;
@@ -269,7 +274,7 @@ note "handlers providing their own subtest_handler"; {
my $formatter2 = MyNullFormatter->new;
my $seesall = MyEventCollectorSeesAll->new;
my $collector = MyEventCollector->new;
- my $history = MyHistory->new;
+ my $history = MyHistory->new( store_events => 1 );
my $state = $CLASS->create(
formatters => [$formatter1, $formatter2],
history => $history,
2  t/Event/change_handler.t
View
@@ -22,7 +22,7 @@ note "Set up an early handler"; {
isa => 'TB2::History',
default => sub {
require TB2::History;
- return TB2::History->new;
+ return TB2::History->new( store_events => 1 );
};
sub handle_event {
9 t/History/History.t
View
@@ -26,7 +26,8 @@ my $Fail = TB2::Result->new_result(
{
my $history = new_ok $CLASS;
- is_deeply $history->results, [];
+ is_deeply $history->result_count, 0;
+ is_deeply $history->event_count, 0;
}
@@ -38,14 +39,12 @@ my $Fail = TB2::Result->new_result(
);
$ec->post_event( $Pass );
- is_deeply $history->results, [$Pass];
+ is_deeply $history->result_count, 1;
ok $history->can_succeed;
$ec->post_event( $Fail );
- is_deeply $history->results, [
- $Pass, $Fail
- ];
+ is_deeply $history->result_count, 2;
ok !$history->can_succeed;
}
1  t/History/HistoryStats.t
View
@@ -32,7 +32,6 @@ note "basic history stats"; {
);
ok!$history->has_results, q{we no not yet have results};
- is_deeply $history->results, [], q{blank results set};
$ec->post_event( Pass() );
$ec->post_event( Fail() );
18 t/History/consume.t
View
@@ -10,7 +10,7 @@ use_ok $CLASS;
use TB2::Events;
note "merge history stacks"; {
- my $h1 = $CLASS->new;
+ my $h1 = $CLASS->new( store_events => 1 );
my $pass = TB2::Result->new_result( pass => 1 );
my $fail = TB2::Result->new_result( pass => 0 );
@@ -18,7 +18,7 @@ note "merge history stacks"; {
$h1->accept_event($_) for $pass, $pass, $pass;
is $h1->result_count, 3, q{H1 count};
- my $h2 = $CLASS->new;
+ my $h2 = $CLASS->new( store_events => 1 );
$h2->accept_event($_) for $fail, $fail, $fail;
is $h2->result_count, 3, q{H2 count};
@@ -27,10 +27,22 @@ note "merge history stacks"; {
is $h1->result_count, 6, q{H1 consumed H2};
is $h1->fail_count, 3 , q{H1 picked up the tests from H2 correctly};
- my $h3 = $CLASS->new;
+ my $h3 = $CLASS->new( store_events => 1 );
$h3->accept_event($_) for $pass, $fail;
$h1->consume( $h3 ) for 1..10;
is $h1->result_count, 26, q{consume appends history};
}
+
+
+note "Try to consume with storage off"; {
+ my $h1 = $CLASS->new;
+ my $h2 = $CLASS->new;
+
+ ok !eval { $h2->consume( $h1 ); 1 };
+ is $@, sprintf "Cannot consume() a History object which has store_events() off at %s line %d.\n",
+ __FILE__, __LINE__-2;
+}
+
+done_testing;
8 t/Tester2/state_untouched.t
View
@@ -10,15 +10,15 @@ use TB2::Tester;
note "test state left untouched"; {
my $ec = Test::Simple->builder->test_state;
- is_deeply $ec->history->events, [], "no events in the EC";
- is_deeply $ec->history->results, [], "no results in the EC";
+ is_deeply $ec->history->event_count, 0, "no events in the EC";
+ is_deeply $ec->history->result_count, 0, "no results in the EC";
my $have = capture {
Test::Simple::ok( 1 );
};
- is_deeply $ec->history->events, [], "still no events";
- is_deeply $ec->history->results, [], "still no results";
+ is_deeply $ec->history->event_count, 0, "still no events";
+ is_deeply $ec->history->result_count, 0, "still no results";
}
done_testing;
2  t/died.t
View
@@ -39,5 +39,5 @@ ERR
$TB->is_eq($?, 250, "exit code");
- exit grep { !$_ } $TB->summary;
+ exit $TB->history->test_was_successful ? 0 : 1;
}
14 t/fail-like.t
View
@@ -1,20 +1,12 @@
#!/usr/bin/perl -w
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
# There was a bug with like() involving a qr// not failing properly.
# This tests against that.
use strict;
+use warnings;
+use lib 't/lib';
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
@@ -74,5 +66,5 @@ OUT
END {
# Test::More thinks it failed. Override that.
- exit(scalar grep { !$_ } $TB->summary);
+ exit $TB->history->test_was_successful ? 0 : 1;
}
3  t/no_tests.t
View
@@ -22,5 +22,4 @@ is($tb->read('err'), <<ERR);
# No tests run!
ERR
-exit grep { !$_ } $tb->summary;
-
+exit $tb->history->test_was_successful ? 0 : 1;
6 t/subtest/basic.t
View
@@ -145,15 +145,15 @@ note "skip_all subtest"; {
my $tb = Test::Builder::NoOutput->create;
$tb->level(0);
+ is $tb->history->skip_count, 0;
+
$tb->subtest("skippy says he loves you" => sub {
$tb->plan( skip_all => 'cuz I said so' );
$tb->ok(1, "this should not run");
$tb->ok(0, "nor this");
});
- my @details = $tb->details;
- is $details[-1]{type}, 'skip',
- 'Subtests which "skip_all" are reported as skipped tests';
+ is $tb->history->skip_count, 1, 'Subtests which "skip_all" are reported as skipped tests';
}
Please sign in to comment.
Something went wrong with that request. Please try again.