1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
|
package Test::BDD::Cucumber::Harness::TestBuilder;
$Test::BDD::Cucumber::Harness::TestBuilder::VERSION = '0.26';
=head1 NAME
Test::BDD::Cucumber::Harness::TestBuilder - Pipes step output via Test::Builder
=head1 VERSION
version 0.26
=head1 DESCRIPTION
A L<Test::BDD::Cucumber::Harness> subclass whose output is sent to
L<Test::Builder>.
=cut
use strict;
use warnings;
use Moose;
use Test::More;
extends 'Test::BDD::Cucumber::Harness';
has 'fail_skip' => ( is => 'rw', isa => 'Bool', default => 0 );
my $li = ' ' x 7;
my $ni = ' ' x 4;
my $si = ' ' x 9;
my $di = ' ' x 17;
sub feature {
my ( $self, $feature ) = @_;
note "${li}Feature: " . $feature->name;
note "$li$ni" . $_->content for @{ $feature->satisfaction };
note "";
}
sub scenario {
my ( $self, $scenario, $dataset ) = @_;
note "$li${ni}Scenario: " . ($scenario->name || '');
}
sub scenario_done { note ""; }
sub step {}
sub step_done {
my ($self, $context, $result) = @_;
my $status = $result->result;
my $step = $context->step;
my $step_name;
if ( $context->is_hook )
{
$status ne 'undefined' and $status ne 'pending' and $status ne 'passing' or return;
$step_name = 'In ' . ucfirst( $context->verb ) . ' Hook';
}
else
{
$step_name = $si . ucfirst($step->verb_original) . ' ' . $context->text;
}
if ( $status eq 'undefined' || $status eq 'pending' ) {
if ( $self->fail_skip ) {
fail( "No matcher for: $step_name" );
$self->_note_step_data( $step );
} else {
TODO: { todo_skip $step_name, 1 };
$self->_note_step_data( $step );
}
} elsif ( $status eq 'passing' ) {
pass( $step_name );
$self->_note_step_data( $step );
} else {
fail( $step_name );
$self->_note_step_data( $step );
if ( ! $context->is_hook )
{
my $step_location = ' in step at ' . $step->line->document->filename . ' line ' . $step->line->number . '.';
diag( $step_location );
}
diag( $result->output );
}
}
sub _note_step_data {
my ( $self, $step ) = @_;
return unless $step;
my @step_data = @{ $step->data_as_strings };
return unless @step_data;
if ( ref( $step->data ) eq 'ARRAY' ) {
for ( @step_data ) {
note( $di . $_ );
}
} else {
note $di . '"""';
for ( @step_data ) {
note( $di . ' ' . $_ );
}
note $di . '"""';
}
}
sub shutdown { done_testing(); }
=head1 AUTHOR
Peter Sergeant C<pete@clueball.com>
=head1 LICENSE
Copyright 2011-2014, Peter Sergeant; Licensed under the same terms as Perl
=cut
1;
|