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
133
134
|
package Test::BDD::Cucumber::Errors;
$Test::BDD::Cucumber::Errors::VERSION = '0.26';
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(parse_error_from_line);
=head1 NAME
Test::BDD::Cucumber::Errors - Consistently formatted errors
=head1 VERSION
version 0.26
=head1 DESCRIPTION
Consistently formatted errors
=head1 NOTE
This module is not intended to help throw error classes, simply to provide
helpers for consistently formatting certain errors. Most of the errors thrown in
practice are errors with the input test scenarios, and it's helpful to have the
location of the error and context when debugging those. Perhaps in the future
these can return error objects.
=head1 SYNOPSIS
use Test::BDD::Cucumber::Errors qw/parse_error_from_line/;
parse_error_from_line(
"Your input was bad",
$line
);
=head1 PARSER ERRORS
=head2 parse_error_from_line
Generates a parser error from a L<Test::BDD::Cucumber::Model::Line> object, and
error reason:
parse_error_from_line(
"Your input was bad",
$line
);
=cut
sub parse_error_from_line {
my ( $message, $line ) = @_;
my $error = "-- Parse Error --\n\n $message\n";
$error .= " at [%s] line %d\n";
$error .= " thrown by: [%s] line %d\n\n";
$error .= "-- [%s] --\n\n";
$error .= "%s";
$error .= "\n%s\n";
# Get the caller data
my ( $caller_filename, $caller_line ) = (caller())[1,2];
# Get the simplistic filename and line number it occured on
my $feature_filename = $line->document->filename || "(no filename)";
my $feature_line = $line->number;
# Get the context lines
my ( $start_line, @lines ) =
_get_context_range( $line->document, $feature_line );
my $formatted_lines;
for ( 0 .. $#lines ) {
my $actual_line = $start_line + $_;
my $mark = ($feature_line == $actual_line) ? '*' : '|';
$formatted_lines .=
sprintf("% 3d%s %s\n",
$actual_line, $mark, $lines[$_]
);
}
return(
sprintf( $error,
$feature_filename, $feature_line,
$caller_filename, $caller_line,
$feature_filename, $formatted_lines,
('-' x ((length $feature_filename) + 8))
)
);
}
sub _get_context_range {
my ( $document, $number ) = @_;
# Context range
my $min_range = 1;
my $max_range = (scalar @{$document->lines});
my @range = (
$number - 2, $number - 1,
$number,
$number + 1, $number + 2
);
# Push the range higher if needed
while ( $range[0] < $min_range ) {
@range = map { $_+1 } @range;
}
# Push the range lower if needed
while ( $range[4] > $max_range ) {
@range = map { $_-1 } @range;
}
# Then cut it off
@range = grep { $_ >= $min_range } @range;
@range = grep { $_ <= $max_range } @range;
return( $range[0], map { $document->lines->[$_ - 1]->raw_content } @range );
}
=head1 AUTHOR
Peter Sergeant C<pete@clueball.com>
=head1 LICENSE
Copyright 2014, Peter Sergeant; Licensed under the same terms as Perl
=cut
1;
|
