Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add TB2::History->as_hash and make as_hash recursive.

This makes dumping the event stream as_hash have the complete information.

I decided not to dump last_result or last_event because that seemed redundant
if you're looking at the whole event stream.  You're normally only looking
at the history object as part of a subtest_end event.

Decided not to dump the event storage, that would get large and recursive.

Decided not to dump store_events as that is not information about the
state of the test, but the state of the history object.  This is just data.
  • Loading branch information...
commit 55f5314c1607a134f9c4f0c93e6c540475788ef0 1 parent 9e5ed1a
Michael G. Schwern schwern authored
25 lib/TB2/CanAsHash.pm
View
@@ -2,6 +2,7 @@ package TB2::CanAsHash;
use TB2::Mouse ();
use TB2::Mouse::Role;
+with 'TB2::CanTry';
=head1 NAME
@@ -25,6 +26,11 @@ TB2::CanAsHash - a role to dump an object as a hash
Returns all the attributes and data associated with this C<$object> as
a hash of attributes and values.
+Attributes with undefined values will not be dumped.
+
+It is recursive, objects encountered will have their as_hash method
+called, if they have one.
+
The intent is to provide a way to dump all the information in an
object without having to call methods which may or may not exist.
@@ -34,12 +40,19 @@ Uses L</keys_for_as_hash> to determine which attributes to access.
sub as_hash {
my $self = shift;
- return {
- map {
- my $val = $self->$_();
- defined $val ? ( $_ => $val ) : ()
- } @{$self->keys_for_as_hash}
- };
+
+ my %hash;
+ for my $key (@{$self->keys_for_as_hash}) {
+ my $val = $self->$key();
+
+ next unless defined $val;
+
+ $val = $val->as_hash if eval { $self->try( sub { $val->can("as_hash") } ) };
+
+ $hash{$key} = $val if defined $val;
+ }
+
+ return \%hash;
}
29 lib/TB2/History.pm
View
@@ -8,7 +8,8 @@ use TB2::threads::shared;
with 'TB2::EventHandler',
'TB2::CanTry',
- 'TB2::CanLoad';
+ 'TB2::CanLoad',
+ 'TB2::CanAsHash';
our $VERSION = '1.005000_006';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
@@ -689,7 +690,31 @@ sub consume {
$self->accept_event($_) for @{ $old_history->events };
return;
-};
+}
+
+
+my %Keys_To_Remove = map { $_ => 1 } qw(
+ event_storage
+ store_events
+ last_event
+ last_result
+);
+my @Keys_To_Add = qw(
+ subtest_depth
+ is_subtest
+ is_child_process
+ in_test
+ done_testing
+
+ can_succeed
+ test_was_successful
+);
+sub keys_for_as_hash {
+ my $self = shift;
+
+ my @keys = grep { !$Keys_To_Remove{$_} } @{ $self->TB2::CanAsHash::keys_for_as_hash };
+ return [ @keys, @Keys_To_Add ];
+}
no TB2::Mouse;
4 t/Event/SubtestEnd.t
View
@@ -25,8 +25,8 @@ note "defaults"; {
event_type => "subtest_end",
object_id => $event->object_id,
pid => $$,
- history => $history,
- result => $event->result,
+ history => $history->as_hash,
+ result => $event->result->as_hash,
};
is $event->result->name, "No tests run in subtest";
82 t/History/as_hash.t
View
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+BEGIN { require "t/test.pl" }
+
+use TB2::History;
+use TB2::EventCoordinator;
+use TB2::Events;
+
+note "Empty history object as_hash"; {
+ my $history = TB2::History->new;
+
+ is_deeply $history->as_hash, {
+ counter => 0,
+ event_count => 0,
+ fail_count => 0,
+ literal_fail_count => 0,
+ literal_pass_count => 0,
+ pass_count => 0,
+ result_count => 0,
+ skip_count => 0,
+ todo_count => 0,
+
+ object_id => $history->object_id,
+
+ subtest_depth => 0,
+ is_subtest => 0,
+ is_child_process => 0,
+ in_test => 0,
+ done_testing => 0,
+
+ can_succeed => 1,
+ test_was_successful => 0,
+ };
+}
+
+
+note "Empty history object as_hash"; {
+ my $ec = TB2::EventCoordinator->new(
+ formatters => [],
+ );
+ my $history = $ec->history;
+
+ my $plan = TB2::Event::SetPlan->new( asserts_expected => 2 );
+ my @results = (TB2::Result->new_result( pass => 1 )) x 2;
+ my $test_end = TB2::Event::TestEnd->new;
+
+ $ec->post_event($_) for ($plan, @results, $test_end);
+
+ is_deeply $history->as_hash, {
+ counter => 2,
+ event_count => 5,
+ fail_count => 0,
+ literal_fail_count => 0,
+ literal_pass_count => 2,
+ pass_count => 2,
+ result_count => 2,
+ skip_count => 0,
+ todo_count => 0,
+
+ object_id => $history->object_id,
+
+ subtest_depth => 0,
+ is_subtest => 0,
+ is_child_process => 0,
+ in_test => 0,
+ done_testing => 1,
+
+ can_succeed => 1,
+ test_was_successful => 1,
+
+ pid_at_test_start => $$,
+
+ plan => $plan->as_hash,
+ test_end => $test_end->as_hash,
+ test_start => $history->test_start->as_hash
+ };
+}
+
+done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.