Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Make History no longer store events #317

Merged
merged 11 commits into from

1 participant

@schwern
Owner

I would like some review and comments on this before I push it in please.

Implements #198

schwern added some commits
@schwern schwern Touch up the synopsis and description. 581ee89
@schwern schwern Move event storage out of TB2::History and into a new TB2::History::E…
…ventStorage object.

Then we can add an EventStorage that throws out events.

This was the last use of TB2::Stack and TB2::StackBuilder, so they're removed.

For #198
9626992
@schwern schwern Add TB2::History::NoEventStorage which TB2::History will use.
For #198
97d3d48
@schwern schwern Make NoEventStorage inherit from EventStorage so isa(EventStorage) wo…
…rks.

For #198
e98b44b
@schwern schwern Un-hard-code the event storage class.
Not documenting it just yet, not sure I want to expose it.
92d3823
@schwern schwern Add an option to turn off event storage.
Also test that things work with event storage off.  Not terribly well tested right now.

For #198
af577ec
@schwern schwern Move the History->consume tests into their own test.
They're a bit complicated.

For #198
e47df19
@schwern schwern Make the errors from NoEventStorage bubble up through History.
So the user sees their own call to TB2::History not inside TB2::History.

For #198
adc2c55
@schwern schwern 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
b1aa706
@schwern schwern Remove the now redundant History->test_count
Synonym for result_count

For #198
43a460e
@schwern schwern Consolodate the statistics in History
* Move all the count attributes together
* Remove a now irrelevant comment

For #198
e98bf15
@schwern schwern merged commit a848365 into Test-Builder1.5
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on May 11, 2012
  1. @schwern
Commits on May 21, 2012
  1. @schwern

    Move event storage out of TB2::History and into a new TB2::History::E…

    schwern authored
    …ventStorage object.
    
    Then we can add an EventStorage that throws out events.
    
    This was the last use of TB2::Stack and TB2::StackBuilder, so they're removed.
    
    For #198
Commits on May 22, 2012
  1. @schwern
Commits on May 25, 2012
  1. @schwern
  2. @schwern

    Un-hard-code the event storage class.

    schwern authored
    Not documenting it just yet, not sure I want to expose it.
  3. @schwern

    Add an option to turn off event storage.

    schwern authored
    Also test that things work with event storage off.  Not terribly well tested right now.
    
    For #198
  4. @schwern

    Move the History->consume tests into their own test.

    schwern authored
    They're a bit complicated.
    
    For #198
  5. @schwern

    Make the errors from NoEventStorage bubble up through History.

    schwern authored
    So the user sees their own call to TB2::History not inside TB2::History.
    
    For #198
  6. @schwern

    Swith over to not storing test events.

    schwern authored
    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
Commits on May 26, 2012
  1. @schwern

    Remove the now redundant History->test_count

    schwern authored
    Synonym for result_count
    
    For #198
  2. @schwern

    Consolodate the statistics in History

    schwern authored
    * Move all the count attributes together
    * Remove a now irrelevant comment
    
    For #198
This page is out of date. Refresh to see the latest.
Showing with 466 additions and 480 deletions.
  1. +7 −0 Changes
  2. +3 −1 examples/TB2/lib/TB2/NoWarnings.pm
  3. +1 −1  lib/TB2/Event/SubtestEnd.pm
  4. +98 −57 lib/TB2/History.pm
  5. +89 −0 lib/TB2/History/EventStorage.pm
  6. +72 −0 lib/TB2/History/NoEventStorage.pm
  7. +0 −156 lib/TB2/Stack.pm
  8. +0 −79 lib/TB2/StackBuilder.pm
  9. +1 −0  lib/TB2/Tester.pm
  10. +15 −9 lib/Test/Builder.pm
  11. +3 −1 t/Builder/context.t
  12. +9 −1 t/Builder/current_test/test_number.t
  13. +7 −1 t/Builder/details.t
  14. +3 −2 t/Builder/reset.t
  15. +3 −2 t/Builder2/NoWarnings.t
  16. +0 −35 t/Builder2/Stack.t
  17. +0 −64 t/Builder2/StackBuilder.t
  18. +5 −1 t/Builder2/context.t
  19. +1 −4 t/Builder2/ok_starts_a_stream.t
  20. +10 −5 t/Event/TestState.t
  21. +1 −1  t/Event/change_handler.t
  22. +28 −0 t/History/EventStorage.t
  23. +22 −5 t/History/History.t
  24. +0 −34 t/History/HistoryStats.t
  25. +28 −0 t/History/NoEventStorage.t
  26. +48 −0 t/History/consume.t
  27. +4 −4 t/Tester2/state_untouched.t
  28. +1 −1  t/died.t
  29. +3 −11 t/fail-like.t
  30. +1 −2  t/no_tests.t
  31. +3 −3 t/subtest/basic.t
View
7 Changes
@@ -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
View
4 examples/TB2/lib/TB2/NoWarnings.pm
@@ -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
]);
View
2  lib/TB2/Event/SubtestEnd.pm
@@ -113,7 +113,7 @@ sub _build_result {
$result_args{skip} = 1;
$result_args{reason} = $subtest_plan->skip_reason;
}
- elsif( $subtest_history->test_count == 0 ) {
+ elsif( $subtest_history->result_count == 0 ) {
# The subtest didn't run any tests
my $name = $result_args{name};
$result_args{name} = "No tests run in subtest";
View
155 lib/TB2/History.pm
@@ -3,7 +3,6 @@ package TB2::History;
use Carp;
use TB2::Mouse;
use TB2::Types;
-use TB2::StackBuilder;
use TB2::threads::shared;
with 'TB2::EventHandler',
@@ -16,16 +15,14 @@ $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval
=head1 NAME
-TB2::History - Manage the history of test results
+TB2::History - Holds information about the state of the test
=head1 SYNOPSIS
use TB2::History;
- my $history = TB2::History->new;
- my $ec = TB2::EventCoordinator->create(
- history => $history
- );
+ # An EventCoordinator contains a History object by default
+ my $ec = TB2::EventCoordinator->create();
my $pass = TB2::Result->new_result( pass => 1 );
$ec->post_event( $pass );
@@ -38,7 +35,20 @@ TB2::History - Manage the history of test results
=head1 DESCRIPTION
-This object stores and manages the history of test results.
+TB2::History records information and statistics about the state of the
+test. It watches and analyses events as they happen. It is used to
+get information about the state of the test such as has it started,
+has it ended, is it passing, how many tests have run and so on.
+
+The history for a test is usually accessed by going through the
+L<TB2::TestState> C<history> accessor.
+
+=for later
+To save memory it does not, by default, store the complete history of
+all events.
+
+Each subtest gets its own L<TB2::EventCoordinator> and thus its own
+TB2::History object.
It is a L<TB2::EventHandler>.
@@ -52,6 +62,28 @@ It is a L<TB2::EventHandler>.
Creates a new, unique History object.
+new() takes the following options.
+
+=head3 store_events
+
+If true, $history will keep a complete record of all test events
+accessable via L<events> and L<results>. This will cause memory usage
+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 false, events are not stored by default.
+
+=cut
+
+has store_events =>
+ is => 'ro',
+ isa => 'Bool',
+ default => 0
+;
+
+
=head2 Misc
=head3 object_id
@@ -70,25 +102,54 @@ Unless otherwise stated, these are all accessor methods of the form:
my $value = $history->method; # get
$history->method($value); # set
-
=head2 Events
=head3 events
-A TB2::Stack of events, that include Result objects.
+ my $events = $history->events;
+
+An array ref of all events seen.
+
+=cut
+
+sub event_storage_class {
+ return $_[0]->store_events ? "TB2::History::EventStorage" : "TB2::History::NoEventStorage";
+}
+
+has event_storage =>
+ is => 'ro',
+ isa => 'TB2::History::EventStorage',
+ default => sub {
+ my $storage_class = $_[0]->event_storage_class;
+ $_[0]->load($storage_class);
+ return $storage_class->new;
+ };
+
+sub events {
+ my $self = shift;
+ return $self->event_storage->events;
+}
+
+sub results {
+ my $self = shift;
+ return $self->event_storage->results;
+}
+
=head3 event_count
-Get the count of events that are on the stack.
+ my $count = $history->event_count;
+
+Get the count of events that have been seen.
=cut
-buildstack events => 'Any';
sub handle_event {
my $self = shift;
my $event = shift;
- $self->events_push($event);
+ $self->event_storage->events_push($event);
+ $self->event_count( $self->event_count + 1 );
return;
}
@@ -154,7 +215,8 @@ sub subtest_handler {
my $event = shift;
my $subhistory = $self->new(
- subtest => $event,
+ subtest => $event,
+ store_events => $self->store_events
);
return $subhistory;
@@ -171,43 +233,32 @@ sub handle_set_plan {
return;
}
-sub event_count { shift->events_count }
-sub has_events { shift->events_count > 0 }
+sub has_events { shift->event_count > 0 }
=head2 Results
=head3 results
-A TB2::Stack of Result objects.
-
# The result of test #4.
my $result = $history->results->[3];
=cut
-buildstack results => 'TB2::Result::Base';
sub handle_result {
my $self = shift;
my $result = shift;
- $self->counter( $self->counter + 1 );
-
- $self->results_push($result);
- $self->events_push($result);
-
- $self->_update_statistics($result);
+ $self->_update_result_statistics($result);
+ $self->handle_event($result);
return;
}
-sub result_count { shift->results_count }
=head2 result_count
-Get the count of results stored in the stack.
+The number of results which have been seen.
-NOTE: This could be diffrent from the number of tests that have been
-seen, to get that count use test_count.
=head3 has_results
@@ -222,49 +273,38 @@ sub has_results { shift->result_count > 0 }
=cut
-# %statistic_mapping:
-# attribute_name => code_ref that defines how to increment attribute_name
-#
-# this is used both as a list of attributes to create as well as by
-# _update_statistics to increment the attribute.
-# code_ref will be handed a single result object that was to be added
-# to the results stack.
-
my @statistic_attributes = qw(
pass_count
fail_count
todo_count
skip_count
- test_count
+ result_count
+ event_count
);
-has $_ => (
- is => 'rw',
- isa => 'TB2::Positive_Int',
- default => 0,
-) for @statistic_attributes;
+for my $name (@statistic_attributes) {
+ has $name => (
+ is => 'rw',
+ isa => 'TB2::Positive_Int',
+ default => 0,
+ );
+}
-sub _update_statistics {
+sub _update_result_statistics {
my $self = shift;
my $result = shift;
+ $self->counter( $self->counter + 1 );
$self->pass_count( $self->pass_count + 1 ) if $result->is_pass;
$self->fail_count( $self->fail_count + 1 ) if $result->is_fail;
$self->todo_count( $self->todo_count + 1 ) if $result->is_todo;
$self->skip_count( $self->skip_count + 1 ) if $result->is_skip;
- $self->test_count( $self->test_count + 1 );
+ $self->result_count( $self->result_count + 1 );
return;
}
-=head3 test_count
-
-A count of the number of tests that have been added to results. This
-value is not guaranteed to be the same as results_count if you have
-altered the results_stack. This is a static counter of the number of
-tests that have been seen, not the number of results stored.
-
=head3 pass_count
A count of the number of passed tests have been added to results.
@@ -309,11 +349,11 @@ sub can_succeed {
if( my $plan = $self->plan ) {
if( my $expect = $plan->asserts_expected ) {
# We ran more tests than the plan
- return 0 if $self->test_count > $expect;
+ return 0 if $self->result_count > $expect;
}
elsif( $plan->skip ) {
# We were supposed to skip everything, but we ran tests
- return 0 if $self->test_count;
+ return 0 if $self->result_count;
}
}
@@ -361,11 +401,11 @@ sub test_was_successful {
if( $plan->no_plan ) {
# Didn't run any tests
- return 0 if !$self->test_count;
+ return 0 if !$self->result_count;
}
else {
# Wrong number of tests
- return 0 if $self->test_count != $plan->asserts_expected;
+ return 0 if $self->result_count != $plan->asserts_expected;
}
# We're exiting with non-zero
@@ -411,8 +451,6 @@ sub done_testing {
}
-
-
=head3 counter
my $counter = $formatter->counter;
@@ -593,6 +631,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;
View
89 lib/TB2/History/EventStorage.pm
@@ -0,0 +1,89 @@
+package TB2::History::EventStorage;
+
+use TB2::Mouse;
+
+=head1 NAME
+
+TB2::History::EventStorage - Store all events
+
+=head1 SYNOPSIS
+
+ my $storage = TB2::History::EventStorage->new;
+
+ $storage->event_push($event);
+
+ my $events = $storage->events;
+ my $results = $storage->results;
+
+=head1 DESCRIPTION
+
+This object stores L<TB2::Event>s.
+
+=head2 Constructors
+
+=head3 new
+
+ my $storage = TB2::History::EventStorage->new;
+
+Create a new storage object.
+
+=head2 Methods
+
+=head3 events
+
+ my $events = $storage->events;
+
+Returns all L<TB2::Event>s pushed in so far.
+
+Do I<NOT> alter this array directly. Use L<events_push>.
+
+=head3 results
+
+ my $results = $storage->results;
+
+Returns just the L<TB2::Result>s pushed in so far.
+
+Do I<NOT> alter this array directly. Use L<events_push>.
+
+=cut
+
+has events =>
+ is => 'ro',
+ isa => 'ArrayRef[TB2::Event]',
+ default => sub { [] }
+;
+
+has results =>
+ is => 'ro',
+ isa => 'ArrayRef[TB2::Result]',
+ default => sub { [] }
+;
+
+
+=head3 events_push
+
+ $storage->events_push(@events);
+
+Add any number of @events to C<< $storage->events >>.
+
+=cut
+
+sub events_push {
+ my $self = shift;
+
+ push @{$self->events}, @_;
+ push @{$self->results}, grep $_->isa("TB2::Result::Base"), @_;
+
+ return;
+}
+
+
+=head1 SEE ALSO
+
+L<TB2::History::NoEventStorage> is like EventStorage but it silently
+throws away all events. Saves space.
+
+=cut
+
+
+1;
View
72 lib/TB2/History/NoEventStorage.pm
@@ -0,0 +1,72 @@
+package TB2::History::NoEventStorage;
+
+use Carp;
+use TB2::Mouse;
+extends 'TB2::History::EventStorage';
+
+our @CARP_NOT = qw(TB2::History);
+
+
+=head1 NAME
+
+TB2::History::NoEventStorage - Throw out all events
+
+=head1 SYNOPSIS
+
+ my $storage = TB2::History::NoEventStorage->new;
+
+ # Immediately discarded.
+ $storage->event_push($event);
+
+ # Trying to look at the events causes an exception.
+ my $events = $storage->events;
+ my $results = $storage->results;
+
+=head1 DESCRIPTION
+
+This object throws out all its input events and stores nothing.
+
+This implements the L<TB2::History::EventStorage> interface. It
+exists so that L<TB2::History> can be configured to not store events
+and thus not grow in memory as the tests run.
+
+=head2 Methods
+
+The interface is the same as L<TB2::History::EventStorage> with the
+following exceptions.
+
+=head3 events
+
+=head3 results
+
+If called, they will both throw an exception.
+
+=cut
+
+sub events {
+ croak "Events are not stored";
+}
+
+sub results {
+ croak "Results are not stored";
+}
+
+
+=head3 events_push
+
+Calls to this method will be ignored.
+
+=cut
+
+sub events_push {}
+
+
+=head1 SEE ALSO
+
+L<TB2::History::EventStorage> is like NoEventStorage but it actually
+stores events.
+
+=cut
+
+
+1;
View
156 lib/TB2/Stack.pm
@@ -1,156 +0,0 @@
-package TB2::Stack;
-
-use 5.008001;
-use TB2::Mouse;
-use TB2::Types;
-
-our $VERSION = '1.005000_005';
-$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-
-
-use Carp qw(confess);
-
-
-=head1 NAME
-
-TB2::Stack - A stack object to be used when you need a stack of things.
-
-=head1 SYNOPSIS
-
- # TODO
-
- use TB2::Stack;
- my $stack = TB2::Stack->new;
-
-
-=head1 DESCRIPTION
-
-A generic stack object that centralizes the idea of a stack.
-
-=head1 Methods
-
-
-=head2 type
-
-This is a read only attribute that is to be specified at creation if you
-need to have a stack that only contains a specific type of items.
-
-Because this is a stack the value supplied for type is expected to be the
-subtype for ArrayRef. So, for example, if type => 'Str' then items will
-be of type ArrayRef[Str], if type => undef then items will just remain
-of type ArrayRef. Due to the way that the type system works you can only
-specify the inital value of the item, no complex types can be specified.
-
-Default: undef implying that any item can be contained in the stack.
-
-=cut
-
-has type =>
- is => 'ro',
- isa => 'Maybe[Str]',
- default => undef,
-;
-
-# if type is specified re-write the attribute with one of the right type.
-# [NOTE] idealy this should only overwrite the type, of the existing attr, but I
-# was not able to alter $self->meta->get_attribute('items')->type_constraint
-# and have the changes stick. I'm sure that it's possible but I cant' get it to work.
-sub BUILD {
- my $self = CORE::shift;
- if ( defined $self->type ) {
- my $type = sprintf q{ArrayRef[%s]}, $self->type;
- my $value = $self->items ; # save off the value to plug it in later
-
- delete $self->meta->{attributes}->{items}; #remove the old items attribute to reduce confusion
-
- my $items = $self->meta->add_attribute( 'items' => is => 'rw',
- isa => $type,
- );
- $items->set_value($self, $value ) if defined $value;
- }
-}
-
-=head2 items
-
- my $items = $stack->items;
-
-Returns an array ref of the TB2::AssertRecord objects on
-the stack.
-
-=cut
-
-has items =>
- is => 'rw',
- isa => 'ArrayRef',
- default => sub { [] }
-;
-
-=head2 count
-
-Returns the count of the items in the stack.
-
-=cut
-
-sub count {
- scalar( @{ CORE::shift->items } );
-}
-
-=head2 pop
-
-Remove the last element from the items stack and return it.
-
-=cut
-
-sub pop {
- pop @{ CORE::shift->items };
-}
-
-=head2 shift
-
-Remove the first element of the items stack, and return it.
-
-=cut
-
-sub shift {
- CORE::shift @{ CORE::shift->items };
-}
-
-=head2 splice
-
-!!!! CURRENTLY NOT IMPLIMENTED AS THERE COULD BE ISSUES WITH THREADS !!!!
-
-Add or remove elements anywhere in an array
-
-=cut
-
-sub splice { }
-
-=head2 unshift
-
-Prepend item(s) to the beginning of the items stack.
-
-=cut
-
-sub unshift {
- my $self = CORE::shift;
- # can not use 'unshift' like pop/shift as you need to trip the type check
- $self->items([ @_, @{ $self->items } ]);
-}
-
-=head2 push
-
-Append one or more elements to the items stack.
-
-=cut
-
-sub push {
- my $self = CORE::shift;
- # can not use 'push' like pop/shift as you need to trip the type check
- $self->items([ @{ $self->items }, @_ ]);
-}
-
-
-#TODO: would a map & grep method be sane?
-
-no TB2::Mouse;
-1;
View
79 lib/TB2/StackBuilder.pm
@@ -1,79 +0,0 @@
-package TB2::StackBuilder;
-
-use 5.008001;
-use TB2::Mouse;
-use TB2::Mouse::Exporter;
-use TB2::Types;
-
-our $VERSION = '1.005000_005';
-$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-
-
-use Carp qw(confess);
-
-
-=head1 NAME
-
-TB2::StackBuilder - A stack builder
-
-=head1 SYNOPSIS
-
- # TODO
-
- use TB2::StackBuilder;
- buildstack items => 'Int';
-
- # is the same as having said:
-
- has items => (
- is => 'rw',
- isa => 'ArrayRef[Int]',
- default => sub{[]},
- );
- sub items_push { ... }
- sub items_pop { ... }
- sub items_count{ ... }
-
-=head1 DESCRIPTION
-
-Exports a keyword buildstack to build up an Attribute array and methods consistanly.
-
-=head1 EXPORTED FUNCTIONS
-
-=head2 buildstack
-
- buildstack $name; # stack is just an ArrayRef
- buildstack $name => $subtype; # ArrayRef[$subtype]
-
-=cut
-
-TB2::Mouse::Exporter->setup_import_methods(
- as_is => [ 'buildstack' ],
-);
-
-sub buildstack ($;$) {
- my $meta = caller->meta;
- my ( $name, $subtype ) = @_;
- $meta->add_attribute(
- $name => is => 'rw',
- isa => (defined $subtype) ? qq{ArrayRef[$subtype]} : q{ArrayRef} ,
- default => sub{[]},
- );
-
- $meta->add_method(
- $name.'_push' => sub{ push @{ shift->$name }, @_; }
- ) unless $meta->has_method($name.'_push');
-
- $meta->add_method(
- $name.'_pop' => sub{ pop @{ shift->$name } }
- ) unless $meta->has_method($name.'_pop');
-
- $meta->add_method(
- $name.'_count'=> sub{ scalar( @{ shift->$name } ) }
- ) unless $meta->has_method($name.'_count');
-
-}
-
-
-no TB2::Mouse;
-1;
View
1  lib/TB2/Tester.pm
@@ -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; });
View
24 lib/Test/Builder.pm
@@ -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;
@@ -2209,7 +2215,7 @@ sub _ending {
my $plan = $history->plan;
# They never set a plan nor ran a test.
- return if !$plan && !$history->test_count;
+ return if !$plan && !$history->result_count;
# Forked children often run fragments of tests.
my $in_child = $self->history->is_child_process;
@@ -2252,7 +2258,7 @@ sub test_exit_code {
my $plan = $history->plan;
# They never set a plan nor ran a test.
- return $real_exit_code if !$plan && !$history->test_count;
+ return $real_exit_code if !$plan && !$history->result_count;
# The test bailed out.
if( $history->abort ) {
@@ -2262,7 +2268,7 @@ FAIL
return 255;
}
# Some tests were run...
- elsif( $history->test_count ) {
+ elsif( $history->result_count ) {
# ...but we exited with non-zero
if($real_exit_code) {
$self->diag(<<"FAIL");
View
4 t/Builder/context.t
@@ -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} ];
View
10 t/Builder/current_test/test_number.t
@@ -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";
View
8 t/Builder/details.t
@@ -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();
View
5 t/Builder/reset.t
@@ -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,
View
5 t/Builder2/NoWarnings.t
@@ -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";
}
View
35 t/Builder2/Stack.t
@@ -1,35 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-BEGIN { require 't/test.pl' }
-
-use_ok( 'TB2::Stack' );
-
-# bare type
-{
- ok my $stack = TB2::Stack->new , q{fresh stack} ;
- is_deeply $stack->items, [], q{empty stack};
- ok $stack->push(1..3), q{push};
- is_deeply $stack->items, [1..3], q{stack};
- ok $stack->unshift('nil'), q{unshift};
- is_deeply $stack->items, ['nil',1..3], q{stack};
- is $stack->pop, 3, q{pop};
- is $stack->shift, 'nil', q{shift};
- is_deeply $stack->items, [1,2], q{stack};
- is $stack->count, 2, q{count};
-}
-
-# simple type
-{
- ok my $stack = TB2::Stack->new(type => 'Int') , q{fresh stack} ;
- ok $stack->push(1), q{push int};
- eval { $stack->push(undef) };
- like $@, qr{Attribute \(items\) does not pass the type constraint}, q{type check};
- is_deeply $stack->items, [1];
-
-
-}
-
-done_testing;
View
64 t/Builder2/StackBuilder.t
@@ -1,64 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-BEGIN { require 't/test.pl' }
-
-use_ok( 'TB2::StackBuilder' );
-
-BEGIN {
- package My::One;
- use TB2::Mouse;
- use TB2::StackBuilder;
-}
-
-{
- can_ok 'My::One', qw{buildstack};
-}
-
-BEGIN {
- package My::Two;
- use TB2::Mouse;
- use TB2::StackBuilder;
- buildstack 'items';
-}
-
-{
- can_ok 'My::Two', qw{ buildstack
- items
- items_push
- items_pop
- items_count
- };
- my $two = My::Two->new;
- is_deeply $two->items, [];
- ok $two->items_push(1..3);
- is $two->items_count, 3;
- is_deeply $two->items, [1..3];
- ok $two->items_push('end');
- is $two->items_pop, 'end';
-}
-
-BEGIN {
- package My::Three;
- use TB2::Mouse;
- use TB2::StackBuilder;
- sub nums_count {'buildin'};
- buildstack nums => 'Int';
-}
-
-{
- my $three = My::Three->new;
- is $three->nums_count, 'buildin', q{buildstack does not squash existing methods};
-
- TODO: {
- our $TODO;
- local $TODO = "This would be nice, but the implementation was very inefficient and messed with threads";
-
- eval { $three->nums_push('this is a string') };
- like $@, qr{^Attribute \(nums\) does not pass the type constraint because}, q{type enforced};
- }
-}
-
-done_testing;
View
6 t/Builder2/context.t
@@ -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 {
View
5 t/Builder2/ok_starts_a_stream.t
@@ -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 );
View
15 t/Event/TestState.t
@@ -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,
View
2  t/Event/change_handler.t
@@ -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 {
View
28 t/History/EventStorage.t
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN { require "t/test.pl" }
+
+use TB2::Events;
+
+my $CLASS = 'TB2::History::EventStorage';
+require_ok $CLASS;
+
+note "Event and result storage"; {
+ my $storage = $CLASS->new;
+
+ is_deeply $storage->events, [], "empty events";
+ is_deeply $storage->results, [], "empty results";
+
+ my @events = map { TB2::Event::Comment->new( comment => "No $_" ) } 1..4;
+ my @results = map { TB2::Result->new_result } 1..2;
+
+ $storage->events_push( @events, @results );
+
+ is_deeply $storage->events, [@events, @results], "events_push to events";
+ is_deeply $storage->results, [@results], "events_push split out results";
+}
+
+done_testing;
View
27 t/History/History.t
@@ -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;
}
@@ -61,5 +60,23 @@ my $Fail = TB2::Result->new_result(
isnt $history1->object_id, $history2->object_id, "history object_ids are unique";
}
+note "Turn off event storage";
+{
+ my $history = $CLASS->new(
+ store_events => 0
+ );
+
+ $history->accept_event( $Pass ) for 1..3;
+ is $history->result_count, 3;
+ is $history->event_count, 3;
+
+ ok !eval { $history->events; 1 };
+ is $@, sprintf "Events are not stored at %s line %d.\n", __FILE__, __LINE__-1;
+
+ ok !eval { $history->results; 1 };
+ is $@, sprintf "Results are not stored at %s line %d.\n", __FILE__, __LINE__-1;
+
+ ok !eval { $history->store_events(1) }, "can't turn on storage for an existing object";
+}
done_testing;
View
34 t/History/HistoryStats.t
@@ -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() );
@@ -40,7 +39,6 @@ note "basic history stats"; {
ok $history->has_results, q{we have results};
is $history->result_count, 4, q{count looks good};
- is $history->test_count, 4, q{test_count};
is $history->pass_count, 2, q{pass_count};
is $history->fail_count, 2, q{fail_count};
is $history->todo_count, 0, q{todo_count};
@@ -49,38 +47,6 @@ note "basic history stats"; {
}
-note "merge history stacks"; {
- my $H1 = new_history;
- my $ec1 = MyEventCoordinator->new(
- history => $H1
- );
-
- $ec1->post_event($_) for Pass(), Pass(), Pass();
- is $H1->result_count, 3, q{H1 count};
-
- my $H2 = new_history;
- my $ec2 = MyEventCoordinator->new(
- history => $H2
- );
-
- $ec2->post_event($_) for Fail(), Fail(), Fail();
- is $H2->result_count, 3, q{H2 count};
-
- $H1->consume($H2);
- is $H1->result_count, 6, q{H1 consumed H2};
- is $H1->fail_count, 3 , q{H1 picked up the tests from H2 correctly};
-
- my $h = new_history;
- my $ec = MyEventCoordinator->new( history => $h );
- $ec->post_event($_) for Pass(), Fail();
-
- $H1->consume( $h ) for 1..10;
-
- is $H1->result_count, 26, q{consume appends history};
-
-}
-
-
note "multiple results with same test number"; {
my $h = new_history;
my $ec = MyEventCoordinator->new( history => $h );
View
28 t/History/NoEventStorage.t
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN { require "t/test.pl" }
+
+use TB2::Events;
+
+my $CLASS = 'TB2::History::NoEventStorage';
+require_ok $CLASS;
+
+note "Event and result storage"; {
+ my $storage = $CLASS->new;
+
+ isa_ok $storage, $CLASS;
+ isa_ok $storage, "TB2::History::EventStorage";
+
+ ok !eval { is_deeply $storage->events; 1 };
+ ok !eval { is_deeply $storage->results; 1 };
+
+ $storage->events_push( TB2::Event::Comment->new( comment => "No 1" ) );
+
+ ok !eval { is_deeply $storage->events; 1 };
+ ok !eval { is_deeply $storage->results; 1 };
+}
+
+done_testing;
View
48 t/History/consume.t
@@ -0,0 +1,48 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+BEGIN { require 't/test.pl' }
+
+my $CLASS = "TB2::History";
+use_ok $CLASS;
+use TB2::Events;
+
+note "merge history stacks"; {
+ my $h1 = $CLASS->new( store_events => 1 );
+
+ my $pass = TB2::Result->new_result( pass => 1 );
+ my $fail = TB2::Result->new_result( pass => 0 );
+
+ $h1->accept_event($_) for $pass, $pass, $pass;
+ is $h1->result_count, 3, q{H1 count};
+
+ my $h2 = $CLASS->new( store_events => 1 );
+
+ $h2->accept_event($_) for $fail, $fail, $fail;
+ is $h2->result_count, 3, q{H2 count};
+
+ $h1->consume($h2);
+ 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( 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;
View
8 t/Tester2/state_untouched.t
@@ -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;
View
2  t/died.t
@@ -39,5 +39,5 @@ ERR
$TB->is_eq($?, 250, "exit code");
- exit grep { !$_ } $TB->summary;
+ exit $TB->history->test_was_successful ? 0 : 1;
}
View
14 t/fail-like.t
@@ -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;
}
View
3  t/no_tests.t
@@ -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;
View
6 t/subtest/basic.t
@@ -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';
}
Something went wrong with that request. Please try again.