File: TestBuilder.pm

package info (click to toggle)
libtest-bdd-cucumber-perl 0.26-1~bpo70%2B1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy-backports
  • size: 528 kB
  • sloc: perl: 3,436; makefile: 8
file content (119 lines) | stat: -rw-r--r-- 2,722 bytes parent folder | download
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;