Skip to content
This repository

Make History no longer store events #317

Merged
merged 11 commits into from almost 2 years ago

1 participant

Michael G. Schwern
Michael G. Schwern
Owner
schwern commented

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

Implements #198

added some commits
Michael G. Schwern Touch up the synopsis and description. 581ee89
Michael G. 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
Michael G. Schwern Add TB2::History::NoEventStorage which TB2::History will use.
For #198
97d3d48
Michael G. Schwern Make NoEventStorage inherit from EventStorage so isa(EventStorage) wo…
…rks.

For #198
e98b44b
Michael G. Schwern Un-hard-code the event storage class.
Not documenting it just yet, not sure I want to expose it.
92d3823
Michael G. 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
Michael G. Schwern Move the History->consume tests into their own test.
They're a bit complicated.

For #198
e47df19
Michael G. 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
Michael G. 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
Michael G. Schwern Remove the now redundant History->test_count
Synonym for result_count

For #198
43a460e
Michael G. Schwern Consolodate the statistics in History
* Move all the count attributes together
* Remove a now irrelevant comment

For #198
e98bf15
Michael G. Schwern schwern merged commit a848365 into from
Michael G. Schwern schwern closed this
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Showing 11 unique commits by 1 author.

May 10, 2012
Michael G. Schwern Touch up the synopsis and description. 581ee89
May 21, 2012
Michael G. 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
Michael G. Schwern Add TB2::History::NoEventStorage which TB2::History will use.
For #198
97d3d48
May 25, 2012
Michael G. Schwern Make NoEventStorage inherit from EventStorage so isa(EventStorage) wo…
…rks.

For #198
e98b44b
Michael G. Schwern Un-hard-code the event storage class.
Not documenting it just yet, not sure I want to expose it.
92d3823
Michael G. 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
Michael G. Schwern Move the History->consume tests into their own test.
They're a bit complicated.

For #198
e47df19
Michael G. 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
Michael G. 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
Michael G. Schwern Remove the now redundant History->test_count
Synonym for result_count

For #198
43a460e
Michael G. Schwern Consolodate the statistics in History
* Move all the count attributes together
* Remove a now irrelevant comment

For #198
e98bf15
This page is out of date. Refresh to see the latest.
7  Changes
@@ -9,6 +9,13 @@ See README and version control log for Test::Builder2 changes.
9 9
     * Update the resources meta data to point at the correct repository, issues
10 10
       mailing list and home page.
11 11
 
  12
+    Incompatible Changes
  13
+    * The result of each test is no longer stored by default.  This keeps
  14
+      the test framework from consuming more and more memory as tests are
  15
+      run.  Test::Builder->details and Test::Builder->summary will throw
  16
+      exceptions by default.  For most needs, they are replaced with
  17
+      statistical methods in TB2::History. [github 198]
  18
+
12 19
 
13 20
 1.005000_005  Thu Apr 26 15:23:25 PDT 2012
14 21
     New Features
4  examples/TB2/lib/TB2/NoWarnings.pm
@@ -79,10 +79,12 @@ plan is already set, but it doesn't.
79 79
     sub handle_test_end {
80 80
         my $self = shift;
81 81
 
  82
+        $DB::single = 1;
  83
+
82 84
         my $warnings = $self->warnings_seen;
83 85
 
84 86
         $self->builder
85  
-          ->ok( scalar @$warnings, "no warnings" )
  87
+          ->ok( !scalar @$warnings, "no warnings" )
86 88
           ->diag([
87 89
               warnings => $warnings
88 90
           ]);
2  lib/TB2/Event/SubtestEnd.pm
@@ -113,7 +113,7 @@ sub _build_result {
113 113
         $result_args{skip} = 1;
114 114
         $result_args{reason} = $subtest_plan->skip_reason;
115 115
     }
116  
-    elsif( $subtest_history->test_count == 0 ) {
  116
+    elsif( $subtest_history->result_count == 0 ) {
117 117
         # The subtest didn't run any tests
118 118
         my $name = $result_args{name};
119 119
         $result_args{name} = "No tests run in subtest";
155  lib/TB2/History.pm
@@ -3,7 +3,6 @@ package TB2::History;
3 3
 use Carp;
4 4
 use TB2::Mouse;
5 5
 use TB2::Types;
6  
-use TB2::StackBuilder;
7 6
 use TB2::threads::shared;
8 7
 
9 8
 with 'TB2::EventHandler',
@@ -16,16 +15,14 @@ $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval
16 15
 
17 16
 =head1 NAME
18 17
 
19  
-TB2::History - Manage the history of test results
  18
+TB2::History - Holds information about the state of the test
20 19
 
21 20
 =head1 SYNOPSIS
22 21
 
23 22
     use TB2::History;
24 23
 
25  
-    my $history = TB2::History->new;
26  
-    my $ec = TB2::EventCoordinator->create(
27  
-        history => $history
28  
-    );
  24
+    # An EventCoordinator contains a History object by default
  25
+    my $ec = TB2::EventCoordinator->create();
29 26
 
30 27
     my $pass  = TB2::Result->new_result( pass => 1 );
31 28
     $ec->post_event( $pass );
@@ -38,7 +35,20 @@ TB2::History - Manage the history of test results
38 35
 
39 36
 =head1 DESCRIPTION
40 37
 
41  
-This object stores and manages the history of test results.
  38
+TB2::History records information and statistics about the state of the
  39
+test.  It watches and analyses events as they happen.  It is used to
  40
+get information about the state of the test such as has it started,
  41
+has it ended, is it passing, how many tests have run and so on.
  42
+
  43
+The history for a test is usually accessed by going through the
  44
+L<TB2::TestState> C<history> accessor.
  45
+
  46
+=for later
  47
+To save memory it does not, by default, store the complete history of
  48
+all events.
  49
+
  50
+Each subtest gets its own L<TB2::EventCoordinator> and thus its own
  51
+TB2::History object.
42 52
 
43 53
 It is a L<TB2::EventHandler>.
44 54
 
@@ -52,6 +62,28 @@ It is a L<TB2::EventHandler>.
52 62
 
53 63
 Creates a new, unique History object.
54 64
 
  65
+new() takes the following options.
  66
+
  67
+=head3 store_events
  68
+
  69
+If true, $history will keep a complete record of all test events
  70
+accessable via L<events> and L<results>.  This will cause memory usage
  71
+to grow over the life of the test.
  72
+
  73
+If false, $history will discard events and only keep a summary of
  74
+events.  L<events> and L<results> will throw an exception if called.
  75
+
  76
+Defaults to false, events are not stored by default.
  77
+
  78
+=cut
  79
+
  80
+has store_events =>
  81
+  is            => 'ro',
  82
+  isa           => 'Bool',
  83
+  default       => 0
  84
+;
  85
+
  86
+
55 87
 =head2 Misc
56 88
 
57 89
 =head3 object_id
@@ -70,25 +102,54 @@ Unless otherwise stated, these are all accessor methods of the form:
70 102
     my $value = $history->method;       # get
71 103
     $history->method($value);           # set
72 104
 
73  
-
74 105
 =head2 Events
75 106
 
76 107
 =head3 events
77 108
 
78  
-A TB2::Stack of events, that include Result objects.
  109
+    my $events = $history->events;
  110
+
  111
+An array ref of all events seen.
  112
+
  113
+=cut
  114
+
  115
+sub event_storage_class {
  116
+    return $_[0]->store_events ? "TB2::History::EventStorage" : "TB2::History::NoEventStorage";
  117
+}
  118
+
  119
+has event_storage =>
  120
+  is            => 'ro',
  121
+  isa           => 'TB2::History::EventStorage',
  122
+  default       => sub {
  123
+      my $storage_class = $_[0]->event_storage_class;
  124
+      $_[0]->load($storage_class);
  125
+      return $storage_class->new;
  126
+  };
  127
+
  128
+sub events {
  129
+    my $self = shift;
  130
+    return $self->event_storage->events;
  131
+}
  132
+
  133
+sub results {
  134
+    my $self = shift;
  135
+    return $self->event_storage->results;
  136
+}
  137
+
79 138
 
80 139
 =head3 event_count
81 140
 
82  
-Get the count of events that are on the stack.
  141
+    my $count = $history->event_count;
  142
+
  143
+Get the count of events that have been seen.
83 144
 
84 145
 =cut
85 146
 
86  
-buildstack events => 'Any';
87 147
 sub handle_event {
88 148
     my $self = shift;
89 149
     my $event = shift;
90 150
 
91  
-    $self->events_push($event);
  151
+    $self->event_storage->events_push($event);
  152
+    $self->event_count( $self->event_count + 1 );
92 153
 
93 154
     return;
94 155
 }
@@ -154,7 +215,8 @@ sub subtest_handler {
154 215
     my $event = shift;
155 216
 
156 217
     my $subhistory = $self->new(
157  
-        subtest => $event,
  218
+        subtest      => $event,
  219
+        store_events => $self->store_events
158 220
     );
159 221
 
160 222
     return $subhistory;
@@ -171,43 +233,32 @@ sub handle_set_plan {
171 233
     return;
172 234
 }
173 235
 
174  
-sub event_count  { shift->events_count }
175  
-sub has_events   { shift->events_count > 0 }
  236
+sub has_events   { shift->event_count > 0 }
176 237
 
177 238
 =head2 Results
178 239
 
179 240
 =head3 results
180 241
 
181  
-A TB2::Stack of Result objects.
182  
-
183 242
     # The result of test #4.
184 243
     my $result = $history->results->[3];
185 244
 
186 245
 =cut
187 246
 
188  
-buildstack results => 'TB2::Result::Base';
189 247
 sub handle_result    {
190 248
     my $self = shift;
191 249
     my $result = shift;
192 250
 
193  
-    $self->counter( $self->counter + 1 );
194  
-
195  
-    $self->results_push($result);
196  
-    $self->events_push($result);
197  
-
198  
-    $self->_update_statistics($result);
  251
+    $self->_update_result_statistics($result);
  252
+    $self->handle_event($result);
199 253
 
200 254
     return;
201 255
 }
202  
-sub result_count     { shift->results_count }
203 256
 
204 257
 
205 258
 =head2 result_count
206 259
 
207  
-Get the count of results stored in the stack. 
  260
+The number of results which have been seen.
208 261
 
209  
-NOTE: This could be diffrent from the number of tests that have been
210  
-seen, to get that count use test_count.
211 262
 
212 263
 =head3 has_results
213 264
 
@@ -222,49 +273,38 @@ sub has_results { shift->result_count > 0 }
222 273
 
223 274
 =cut
224 275
 
225  
-# %statistic_mapping: 
226  
-# attribute_name => code_ref that defines how to increment attribute_name
227  
-#
228  
-# this is used both as a list of attributes to create as well as by 
229  
-# _update_statistics to increment the attribute. 
230  
-# code_ref will be handed a single result object that was to be added
231  
-# to the results stack.
232  
-
233 276
 my @statistic_attributes = qw(
234 277
     pass_count
235 278
     fail_count
236 279
     todo_count
237 280
     skip_count
238  
-    test_count
  281
+    result_count
  282
+    event_count
239 283
 );
240 284
 
241  
-has $_ => (
242  
-    is => 'rw',
243  
-    isa => 'TB2::Positive_Int',
244  
-    default => 0,
245  
-) for @statistic_attributes;
  285
+for my $name (@statistic_attributes) {
  286
+    has $name => (
  287
+        is => 'rw',
  288
+        isa => 'TB2::Positive_Int',
  289
+        default => 0,
  290
+    );
  291
+}
246 292
 
247  
-sub _update_statistics {
  293
+sub _update_result_statistics {
248 294
     my $self = shift;
249 295
     my $result = shift;
250 296
 
  297
+    $self->counter( $self->counter + 1 );
251 298
     $self->pass_count( $self->pass_count + 1 ) if $result->is_pass;
252 299
     $self->fail_count( $self->fail_count + 1 ) if $result->is_fail;
253 300
     $self->todo_count( $self->todo_count + 1 ) if $result->is_todo;
254 301
     $self->skip_count( $self->skip_count + 1 ) if $result->is_skip;
255  
-    $self->test_count( $self->test_count + 1 );
  302
+    $self->result_count( $self->result_count + 1 );
256 303
 
257 304
     return;
258 305
 }
259 306
 
260 307
 
261  
-=head3 test_count
262  
-
263  
-A count of the number of tests that have been added to results. This
264  
-value is not guaranteed to be the same as results_count if you have
265  
-altered the results_stack. This is a static counter of the number of
266  
-tests that have been seen, not the number of results stored.
267  
-
268 308
 =head3 pass_count
269 309
 
270 310
 A count of the number of passed tests have been added to results.
@@ -309,11 +349,11 @@ sub can_succeed {
309 349
     if( my $plan = $self->plan ) {
310 350
         if( my $expect = $plan->asserts_expected ) {
311 351
             # We ran more tests than the plan
312  
-            return 0 if $self->test_count > $expect;
  352
+            return 0 if $self->result_count > $expect;
313 353
         }
314 354
         elsif( $plan->skip ) {
315 355
             # We were supposed to skip everything, but we ran tests
316  
-            return 0 if $self->test_count;
  356
+            return 0 if $self->result_count;
317 357
         }
318 358
     }
319 359
 
@@ -361,11 +401,11 @@ sub test_was_successful {
361 401
 
362 402
     if( $plan->no_plan ) {
363 403
         # Didn't run any tests
364  
-        return 0 if !$self->test_count;
  404
+        return 0 if !$self->result_count;
365 405
     }
366 406
     else {
367 407
         # Wrong number of tests
368  
-        return 0 if $self->test_count != $plan->asserts_expected;
  408
+        return 0 if $self->result_count != $plan->asserts_expected;
369 409
     }
370 410
 
371 411
     # We're exiting with non-zero
@@ -411,8 +451,6 @@ sub done_testing {
411 451
 }
412 452
 
413 453
 
414  
-
415  
-
416 454
 =head3 counter
417 455
 
418 456
     my $counter = $formatter->counter;
@@ -593,6 +631,9 @@ sub consume {
593 631
    croak 'consume() only takes History objects'
594 632
      unless eval { $old_history->isa("TB2::History") };
595 633
 
  634
+   croak 'Cannot consume() a History object which has store_events() off'
  635
+     unless eval { $old_history->store_events };
  636
+
596 637
    $self->accept_event($_) for @{ $old_history->events };
597 638
 
598 639
    return;
89  lib/TB2/History/EventStorage.pm
... ...
@@ -0,0 +1,89 @@
  1
+package TB2::History::EventStorage;
  2
+
  3
+use TB2::Mouse;
  4
+
  5
+=head1 NAME
  6
+
  7
+TB2::History::EventStorage - Store all events
  8
+
  9
+=head1 SYNOPSIS
  10
+
  11
+    my $storage = TB2::History::EventStorage->new;
  12
+
  13
+    $storage->event_push($event);
  14
+
  15
+    my $events  = $storage->events;
  16
+    my $results = $storage->results;
  17
+
  18
+=head1 DESCRIPTION
  19
+
  20
+This object stores L<TB2::Event>s.
  21
+
  22
+=head2 Constructors
  23
+
  24
+=head3 new
  25
+
  26
+    my $storage = TB2::History::EventStorage->new;
  27
+
  28
+Create a new storage object.
  29
+
  30
+=head2 Methods
  31
+
  32
+=head3 events
  33
+
  34
+    my $events = $storage->events;
  35
+
  36
+Returns all L<TB2::Event>s pushed in so far.
  37
+
  38
+Do I<NOT> alter this array directly.  Use L<events_push>.
  39
+
  40
+=head3 results
  41
+
  42
+    my $results = $storage->results;
  43
+
  44
+Returns just the L<TB2::Result>s pushed in so far.
  45
+
  46
+Do I<NOT> alter this array directly.  Use L<events_push>.
  47
+
  48
+=cut
  49
+
  50
+has events =>
  51
+  is            => 'ro',
  52
+  isa           => 'ArrayRef[TB2::Event]',
  53
+  default       => sub { [] }
  54
+;
  55
+
  56
+has results =>
  57
+  is            => 'ro',
  58
+  isa           => 'ArrayRef[TB2::Result]',
  59
+  default       => sub { [] }
  60
+;
  61
+
  62
+
  63
+=head3 events_push
  64
+
  65
+    $storage->events_push(@events);
  66
+
  67
+Add any number of @events to C<< $storage->events >>.
  68
+
  69
+=cut
  70
+
  71
+sub events_push {
  72
+    my $self = shift;
  73
+
  74
+    push @{$self->events}, @_;
  75
+    push @{$self->results}, grep $_->isa("TB2::Result::Base"), @_;
  76
+
  77
+    return;
  78
+}
  79
+
  80
+
  81
+=head1 SEE ALSO
  82
+
  83
+L<TB2::History::NoEventStorage> is like EventStorage but it silently
  84
+throws away all events.  Saves space.
  85
+
  86
+=cut
  87
+
  88
+
  89
+1;
72  lib/TB2/History/NoEventStorage.pm
... ...
@@ -0,0 +1,72 @@
  1
+package TB2::History::NoEventStorage;
  2
+
  3
+use Carp;
  4
+use TB2::Mouse;
  5
+extends 'TB2::History::EventStorage';
  6
+
  7
+our @CARP_NOT = qw(TB2::History);
  8
+
  9
+
  10
+=head1 NAME
  11
+
  12
+TB2::History::NoEventStorage - Throw out all events
  13
+
  14
+=head1 SYNOPSIS
  15
+
  16
+    my $storage = TB2::History::NoEventStorage->new;
  17
+
  18
+    # Immediately discarded.
  19
+    $storage->event_push($event);
  20
+
  21
+    # Trying to look at the events causes an exception.
  22
+    my $events  = $storage->events;
  23
+    my $results = $storage->results;
  24
+
  25
+=head1 DESCRIPTION
  26
+
  27
+This object throws out all its input events and stores nothing.
  28
+
  29
+This implements the L<TB2::History::EventStorage> interface.  It
  30
+exists so that L<TB2::History> can be configured to not store events
  31
+and thus not grow in memory as the tests run.
  32
+
  33
+=head2 Methods
  34
+
  35
+The interface is the same as L<TB2::History::EventStorage> with the
  36
+following exceptions.
  37
+
  38
+=head3 events
  39
+
  40
+=head3 results
  41
+
  42
+If called, they will both throw an exception.
  43
+
  44
+=cut
  45
+
  46
+sub events {
  47
+    croak "Events are not stored";
  48
+}
  49
+
  50
+sub results {
  51
+    croak "Results are not stored";
  52
+}
  53
+
  54
+
  55
+=head3 events_push
  56
+
  57
+Calls to this method will be ignored.
  58
+
  59
+=cut
  60
+
  61
+sub events_push {}
  62
+
  63
+
  64
+=head1 SEE ALSO
  65
+
  66
+L<TB2::History::EventStorage> is like NoEventStorage but it actually
  67
+stores events.
  68
+
  69
+=cut
  70
+
  71
+
  72
+1;
156  lib/TB2/Stack.pm
... ...
@@ -1,156 +0,0 @@
1  
-package TB2::Stack;
2  
-
3  
-use 5.008001;
4  
-use TB2::Mouse;
5  
-use TB2::Types;
6  
-
7  
-our $VERSION = '1.005000_005';
8  
-$VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
9  
-
10  
-
11  
-use Carp qw(confess);
12  
-
13  
-
14  
-=head1 NAME
15  
-
16  
-TB2::Stack - A stack object to be used when you need a stack of things.
17  
-
18  
-=head1 SYNOPSIS
19  
-
20  
-   # TODO
21  
-
22  
-   use TB2::Stack;
23  
-   my $stack = TB2::Stack->new;
24  
-   
25  
-
26  
-=head1 DESCRIPTION
27  
-
28  
-A generic stack object that centralizes the idea of a stack. 
29  
-
30  
-=head1 Methods
31  
-
32  
-
33  
-=head2 type
34  
-
35  
-This is a read only attribute that is to be specified at creation if you 
36  
-need to have a stack that only contains a specific type of items. 
37  
-
38  
-Because this is a stack the value supplied for type is expected to be the
39  
-subtype for ArrayRef. So, for example, if type => 'Str' then items will
40  
-be of type ArrayRef[Str], if type => undef then items will just remain
41  
-of type ArrayRef. Due to the way that the type system works you can only
42  
-specify the inital value of the item, no complex types can be specified.
43  
-
44  
-Default: undef implying that any item can be contained in the stack.
45  
-
46  
-=cut
47  
-
48  
-has type => 
49  
-   is           => 'ro',
50  
-   isa          => 'Maybe[Str]',
51  
-   default      => undef,
52  
-;
53  
-
54  
-# if type is specified re-write the attribute with one of the right type. 
55  
-# [NOTE] idealy this should only overwrite the type, of the existing attr, but I
56  
-#        was not able to alter $self->meta->get_attribute('items')->type_constraint
57  
-#        and have the changes stick. I'm sure that it's possible but I cant' get it to work.
58  
-sub BUILD {
59  
-    my $self = CORE::shift;
60  
-    if ( defined $self->type ) {
61  
-        my $type = sprintf q{ArrayRef[%s]}, $self->type;
62  
-        my $value = $self->items ; # save off the value to plug it in later
63  
-
64  
-        delete $self->meta->{attributes}->{items}; #remove the old items attribute to reduce confusion
65  
-
66  
-        my $items = $self->meta->add_attribute( 'items' => is  => 'rw',
67  
-                                                           isa => $type,
68  
-                                              );
69  
-        $items->set_value($self, $value ) if defined $value;
70  
-    }
71  
-}
72  
-
73  
-=head2 items
74  
-
75  
-    my $items = $stack->items;
76  
-
77  
-Returns an array ref of the TB2::AssertRecord objects on
78  
-the stack.
79  
-
80  
-=cut
81  
-
82  
-has items =>
83  
-  is            => 'rw',
84  
-  isa           => 'ArrayRef',
85  
-  default       => sub { [] }
86  
-;
87  
-
88  
-=head2 count
89  
-
90  
-Returns the count of the items in the stack.
91  
-
92  
-=cut
93  
-
94  
-sub count {
95  
-    scalar( @{ CORE::shift->items } );
96  
-}
97  
-
98  
-=head2 pop 
99  
-
100  
-Remove the last element from the items stack and return it.
101  
-
102  
-=cut 
103  
-
104  
-sub pop {
105  
-    pop @{ CORE::shift->items };
106  
-}
107  
-
108  
-=head2 shift 
109  
-
110  
-Remove the first element of the items stack, and return it.
111  
-
112  
-=cut
113  
-
114  
-sub shift {
115  
-    CORE::shift @{ CORE::shift->items };
116  
-}
117  
-
118  
-=head2 splice 
119  
-
120  
-!!!! CURRENTLY NOT IMPLIMENTED AS THERE COULD BE ISSUES WITH THREADS !!!!
121  
-
122  
-Add or remove elements anywhere in an array
123  
-
124  
-=cut
125  
-
126  
-sub splice { }
127  
-
128  
-=head2 unshift 
129  
-
130  
-Prepend item(s) to the beginning of the items stack.
131  
-
132  
-=cut
133  
-
134  
-sub unshift {
135  
-    my $self = CORE::shift;
136  
-    # can not use 'unshift' like pop/shift as you need to trip the type check
137  
-    $self->items([ @_, @{ $self->items } ]);
138  
-}
139  
-
140  
-=head2 push 
141  
-
142  
-Append one or more elements to the items stack.
143  
-
144  
-=cut
145  
-
146  
-sub push {
147  
-    my $self = CORE::shift;
148  
-    # can not use 'push' like pop/shift as you need to trip the type check
149  
-    $self->items([ @{ $self->items }, @_ ]);
150  
-}
151  
-
152  
-
153  
-#TODO: would a map & grep method be sane?
154  
-
155  
-no TB2::Mouse;
156  
-1;
79  lib/TB2/StackBuilder.pm
... ...
@@ -1,79 +0,0 @@
1  
-package TB2::StackBuilder;
2  
-
3  
-use 5.008001;
4  
-use TB2::Mouse;
5  
-use TB2::Mouse::Exporter;
6  
-use TB2::Types;
7  
-
8  
-our $VERSION = '1.005000_005';
9  
-$VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
10  
-
11  
-
12  
-use Carp qw(confess);
13  
-
14  
-
15  
-=head1 NAME
16  
-
17  
-TB2::StackBuilder - A stack builder
18  
-
19  
-=head1 SYNOPSIS
20  
-
21  
-    # TODO
22  
-
23  
-    use TB2::StackBuilder;
24  
-    buildstack items => 'Int';
25  
-
26  
-    # is the same as having said:
27  
-
28  
-    has items => (
29  
-        is => 'rw',
30  
-        isa => 'ArrayRef[Int]',
31  
-        default => sub{[]},
32  
-    );
33  
-    sub items_push { ... }
34  
-    sub items_pop  { ... }
35  
-    sub items_count{ ... }
36  
-        
37  
-=head1 DESCRIPTION
38  
-
39  
-Exports a keyword buildstack to build up an Attribute array and methods consistanly.
40  
-
41  
-=head1 EXPORTED FUNCTIONS
42  
-
43  
-=head2 buildstack
44  
-
45  
-  buildstack $name; # stack is just an ArrayRef
46  
-  buildstack $name => $subtype; # ArrayRef[$subtype]
47  
-
48  
-=cut
49  
-
50  
-TB2::Mouse::Exporter->setup_import_methods(
51  
-    as_is => [ 'buildstack' ],
52  
-);
53  
-
54  
-sub buildstack ($;$) {
55  
-    my $meta = caller->meta;
56  
-    my ( $name, $subtype ) = @_;
57  
-    $meta->add_attribute(
58  
-        $name => is      => 'rw',
59  
-                 isa     => (defined $subtype) ? qq{ArrayRef[$subtype]} : q{ArrayRef} ,
60  
-                 default => sub{[]},
61  
-    );
62  
-
63  
-    $meta->add_method(
64  
-        $name.'_push' => sub{ push @{ shift->$name }, @_; }
65  
-    ) unless $meta->has_method($name.'_push');
66  
-
67  
-    $meta->add_method(
68  
-        $name.'_pop'  => sub{ pop @{ shift->$name } }
69  
-    ) unless $meta->has_method($name.'_pop');
70  
-    
71  
-    $meta->add_method(
72  
-        $name.'_count'=> sub{ scalar( @{ shift->$name } ) }
73  
-    ) unless $meta->has_method($name.'_count');
74  
-    
75  
-}
76  
-
77  
-
78  
-no TB2::Mouse;
79  
-1;
1  lib/TB2/Tester.pm
@@ -68,6 +68,7 @@ sub capture(&) {
68 68
     my $our_ec = $state->push_coordinator;
69 69
 
70 70
     $our_ec->clear_formatters;
  71
+    $our_ec->history( TB2::History->new( store_events => 1 ) );
71 72
 
72 73
     my($ret, $err) = $CLASS->try(sub { $code->(); 1; });
73 74
 
24  lib/Test/Builder.pm
@@ -1741,10 +1741,10 @@ sub current_test {
1741 1741
     return $history->counter unless defined $num;
1742 1742
 
1743 1743
     # If the test counter is being pushed forward fill in the details.
1744  
-    my $results = $history->results;
  1744
+    my $result_count = $history->result_count;
1745 1745
 
1746  
-    if ( $num > @$results ) {
1747  
-        my $last_test_number = @$results ? @$results : 0;
  1746
+    if ( $num > $result_count ) {
  1747
+        my $last_test_number = $result_count ? $result_count : 0;
1748 1748
         $history->counter($last_test_number);
1749 1749
 
1750 1750
         for my $test_number ( $last_test_number + 1 .. $num ) {
@@ -1759,8 +1759,8 @@ sub current_test {
1759 1759
         }
1760 1760
     }
1761 1761
     # If backward, wipe history.  Its their funeral.
1762  
-    elsif ( $num < @$results ) {
1763  
-        $#{$results} = $num - 1;
  1762
+    elsif ( $num < $result_count ) {
  1763
+        $history->result_count($num);
1764 1764
     }
1765 1765
 
1766 1766
     $history->counter($num);
@@ -1801,6 +1801,9 @@ This is a logical pass/fail, so todos are passes.
1801 1801
 
1802 1802
 Of course, test #1 is $tests[0], etc...
1803 1803
 
  1804
+By default, this method will throw an exception unless Test::Builder has
  1805
+been configured to store events.
  1806
+
1804 1807
 =cut
1805 1808
 
1806 1809
 sub summary {
@@ -1870,6 +1873,9 @@ result in this structure:
1870 1873
         reason    => 'insufficient donuts'
1871 1874
       };
1872 1875
 
  1876
+By default, this test will throw an exception unless Test::Builder has
  1877
+been configured to store events.
  1878
+
1873 1879
 =cut
1874 1880
 
1875 1881
 sub details {
@@ -2149,7 +2155,7 @@ sub _sanity_check {
2149 2155
     my $self = shift;
2150 2156
 
2151 2157
     $self->_whoa( $self->current_test < 0, 'Says here you ran a negative number of tests!' );
2152  
-    $self->_whoa( $self->current_test != @{ $self->history->results },
  2158
+    $self->_whoa( $self->current_test != $self->history->result_count,
2153 2159
         'Somehow you got a different number of results than tests ran!' );
2154 2160
 
2155 2161
     return;
@@ -2209,7 +2215,7 @@ sub _ending {
2209 2215
     my $plan    = $history->plan;
2210 2216
 
2211 2217
     # They never set a plan nor ran a test.
2212  
-    return if !$plan && !$history->test_count;
  2218
+    return if !$plan && !$history->result_count;
2213 2219
 
2214 2220
     # Forked children often run fragments of tests.
2215 2221
     my $in_child = $self->history->is_child_process;
@@ -2252,7 +2258,7 @@ sub test_exit_code {
2252 2258
     my $plan    = $history->plan;
2253 2259
 
2254 2260
     # They never set a plan nor ran a test.
2255  
-    return $real_exit_code if !$plan && !$history->test_count;
  2261
+    return $real_exit_code if !$plan && !$history->result_count;
2256 2262
 
2257 2263
     # The test bailed out.
2258 2264
     if( $history->abort ) {
@@ -2262,7 +2268,7 @@ FAIL
2262 2268
         return 255;
2263 2269
     }
2264 2270
     # Some tests were run...
2265  
-    elsif( $history->test_count ) {
  2271
+    elsif( $history->result_count ) {
2266 2272
         # ...but we exited with non-zero
2267 2273
         if($real_exit_code) {
2268 2274
             $self->diag(<<"FAIL");
4  t/Builder/context.t
@@ -9,14 +9,16 @@ use lib 't/lib';
9 9
 BEGIN { require "t/test.pl" }
10 10
 
11 11
 use Test::Builder::NoOutput;
  12
+use TB2::History;
12 13
 
13 14
 my $tb = Test::Builder::NoOutput->create;
  15
+my $history = TB2::History->new( store_events => 1 );
  16
+$tb->test_state->ec->history($history);
14 17
 
15 18
 my $from_idx = 0;
16 19
 sub check_events {
17 20
     my($tb, $line) = @_;
18 21
 
19  
-    my $results = $tb->history->results;
20 22
     my $events  = $tb->history->events;
21 23
 
22 24
     my @have = @{$events}[ $from_idx .. $#{$events} ]; 
10  t/Builder/current_test/test_number.t
@@ -3,8 +3,16 @@
3 3
 # Test that current_test will get the numbering right if no tests
4 4
 # have yet been run by Test::Builder.
5 5
 
  6
+use strict;
  7
+use warnings;
  8
+
6 9
 use Test::Builder;
7  
-$TB = Test::Builder->new;
  10
+use TB2::History;
  11
+
  12
+my $TB = Test::Builder->new;
  13
+my $history = TB2::History->new( store_events => 1 );
  14
+$TB->test_state->ec->history($history);
  15
+
8 16
 $TB->no_header(1);
9 17
 print "ok 1\n";
10 18
 print "ok 2\n";
8  t/Builder/details.t
@@ -7,7 +7,11 @@ use lib 't/lib';
7 7
 
8 8
 use Test::More;
9 9
 use Test::Builder;
  10
+use TB2::History;
  11
+
10 12
 my $Test = Test::Builder->new;
  13
+my $history = TB2::History->new( store_events => 1 );
  14
+$Test->test_state->ec->history($history);
11 15
 
12 16
 $Test->plan( tests => 9 );
13 17
 $Test->level(0);
@@ -91,7 +95,9 @@ is_deeply( \@details, \@Expected_Details );
91 95
 
92 96
 
93 97
 # This test has to come last because it thrashes the test details.
94  
-{
  98
+TODO_SKIP: {
  99
+    local $TODO = "current_test() going backwards is broken and may be removed";
  100
+
95 101
     my $curr_test = $Test->current_test;
96 102
     $Test->current_test(4);
97 103
     my @details = $Test->details();
5  t/Builder/reset.t
@@ -14,6 +14,7 @@ chdir 't';
14 14
 
15 15
 
16 16
 use Test::Builder;
  17
+use TB2::History;
17 18
 my $Test = Test::Builder->new;
18 19
 my $tb = Test::Builder->create;
19 20
 
@@ -57,8 +58,8 @@ $Test->ok( $tb->use_numbers,         , 'use_numbers' );
57 58
 $Test->ok( !$tb->no_header,          , 'no_header' );
58 59
 $Test->ok( !$tb->no_ending,          , 'no_ending' );
59 60
 $Test->is_num( $tb->current_test,   0, 'current_test' );
60  
-$Test->is_num( scalar $tb->summary, 0, 'summary' );
61  
-$Test->is_num( scalar $tb->details, 0, 'details' );
  61
+$Test->is_num( $tb->history->event_count,  0 );
  62
+$Test->is_num( $tb->history->result_count, 0 );
62 63
 $Test->is_eq( fileno $tb->output,
63 64
               fileno $Original_Output{output},         'output' );
64 65
 $Test->is_eq( fileno $tb->failure_output,
5  t/Builder2/NoWarnings.t
@@ -33,9 +33,10 @@ BEGIN { require "t/test.pl" }
33 33
 
34 34
 
35 35
     # Test the result
36  
-    plan tests => 2;
  36
+    plan tests => 3;
37 37
 
38 38
     # qr/...$/m is broken on Debian etch's 5.8.8
39 39
     like $builder->formatter->streamer->read("out"), qr/^1\.\.3\n/m, "count correct";
40  
-    ok $builder->history->results->[2], "no warnings test failed properly";
  40
+    is $builder->history->result_count, 3, "no warnings test ran";
  41
+    is $builder->history->fail_count, 1,   "no warnings test failed properly";
41 42
 }
35  t/Builder2/Stack.t
... ...
@@ -1,35 +0,0 @@
1  
-#!/usr/bin/perl
2  
-
3  
-use strict;
4  
-use warnings;
5  
-
6  
-BEGIN { require 't/test.pl' }
7  
-
8  
-use_ok( 'TB2::Stack' );
9  
-
10  
-# bare type
11  
-{
12  
-    ok my $stack = TB2::Stack->new , q{fresh stack} ;
13  
-    is_deeply $stack->items, [], q{empty stack};
14  
-    ok $stack->push(1..3), q{push};
15  
-    is_deeply $stack->items, [1..3], q{stack};
16  
-    ok $stack->unshift('nil'), q{unshift};
17  
-    is_deeply $stack->items, ['nil',1..3], q{stack};
18  
-    is $stack->pop, 3, q{pop};
19  
-    is $stack->shift, 'nil', q{shift};
20  
-    is_deeply $stack->items, [1,2], q{stack};
21  
-    is $stack->count, 2, q{count};
22  
-}
23  
-
24  
-# simple type
25  
-{
26  
-    ok my $stack = TB2::Stack->new(type => 'Int') , q{fresh stack} ;
27  
-    ok $stack->push(1), q{push int};
28  
-    eval { $stack->push(undef) };
29  
-    like $@, qr{Attribute \(items\) does not pass the type constraint}, q{type check}; 
30  
-    is_deeply $stack->items, [1];
31  
-
32  
-
33  
-}
34  
-
35  
-done_testing;
64  t/Builder2/StackBuilder.t
... ...
@@ -1,64 +0,0 @@
1  
-#!/usr/bin/perl
2  
-
3  
-use strict;
4  
-use warnings;
5  
-
6  
-BEGIN { require 't/test.pl' }
7  
-
8  
-use_ok( 'TB2::StackBuilder' );
9  
-
10  
-BEGIN {
11  
-   package My::One;
12  
-   use TB2::Mouse;
13  
-   use TB2::StackBuilder;
14  
-}
15  
-
16  
-{
17  
-   can_ok 'My::One', qw{buildstack};
18  
-}
19  
-
20  
-BEGIN {
21  
-   package My::Two;
22  
-   use TB2::Mouse;
23  
-   use TB2::StackBuilder;
24  
-   buildstack 'items';
25  
-}
26  
-
27  
-{
28  
-   can_ok 'My::Two', qw{ buildstack
29  
-                         items
30  
-                         items_push
31  
-                         items_pop
32  
-                         items_count
33  
-                       };
34  
-   my $two = My::Two->new;
35  
-   is_deeply $two->items, [];
36  
-   ok $two->items_push(1..3);
37  
-   is $two->items_count, 3;
38  
-   is_deeply $two->items, [1..3];
39  
-   ok $two->items_push('end');
40  
-   is $two->items_pop, 'end';
41  
-}
42  
-
43  
-BEGIN {
44  
-   package My::Three;
45  
-   use TB2::Mouse;
46  
-   use TB2::StackBuilder;
47  
-   sub nums_count {'buildin'};
48  
-   buildstack nums => 'Int';
49  
-}
50  
-
51  
-{
52  
-   my $three = My::Three->new;
53  
-   is $three->nums_count, 'buildin', q{buildstack does not squash existing methods};
54  
-
55  
-   TODO: {
56  
-       our $TODO;
57  
-       local $TODO = "This would be nice, but the implementation was very inefficient and messed with threads";
58  
-
59  
-       eval { $three->nums_push('this is a string') };
60  
-       like $@, qr{^Attribute \(nums\) does not pass the type constraint because}, q{type enforced};
61  
-   }
62  
-}
63  
-
64  
-done_testing;
6  t/Builder2/context.t
@@ -6,9 +6,13 @@ use warnings;
6 6
 BEGIN { require 't/test.pl' }
7 7
 
8 8
 use Test::Builder2;
  9
+use TB2::History;
  10
+
9 11
 my $tb = Test::Builder2->create;
10 12
 $tb->test_state->clear_formatters;
11  
-
  13
+$tb->test_state->ec->history(
  14
+    TB2::History->new( store_events => 1 )
  15
+);
12 16
 
13 17
 my $from_idx = 0;
14 18
 sub check_events {
5  t/Builder2/ok_starts_a_stream.t
@@ -12,10 +12,7 @@ my $tb = Test::Builder2->default;
12 12
 # ok() starts the stream automatically
13 13
 {
14 14
     $tb->ok(1);
15  
-