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
120
121
122
123
124
125
126
127
128
129
130
131
132
|
package Test::BDD::Cucumber::Harness::TestBuilder;
$Test::BDD::Cucumber::Harness::TestBuilder::VERSION = '0.50';
=head1 NAME
Test::BDD::Cucumber::Harness::TestBuilder - Pipes step output via Test::Builder
=head1 VERSION
version 0.50
=head1 DESCRIPTION
A L<Test::BDD::Cucumber::Harness> subclass whose output is sent to
L<Test::Builder>.
=head1 OPTIONS
=head2 fail_skip
Boolean - makes tests with no matcher fail
=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 ) {
if ( $status eq 'undefined' ) {
fail("No matcher for: $step_name");
} else {
fail("Test skipped due to failure in previous step");
}
$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-2016, Peter Sergeant; Licensed under the same terms as Perl
=cut
1;
|
