File Coverage

inc/Test/Cukes.pm
Criterion Covered Total %
statement 54 68 79.4
branch 10 16 62.5
condition 1 3 33.3
subroutine 11 12 91.6
pod 0 3 0.0
total 76 102 74.5


line stmt bran cond sub pod time code
1             #line 1
2 1     1   627 package Test::Cukes;
  1         2  
  1         32  
3 1     1   4 use strict;
  1         2  
  1         28  
4 1     1   878 use warnings;
  1         43631  
  1         29  
5 1     1   953 use Test::Cukes::Feature;
  1         1225  
  1         6  
6 1     1   4121 use Carp::Assert;
  1         1657  
  1         59  
7             use Try::Tiny;
8 1     1   5  
  1         3  
  1         1007  
9             use base 'Test::Builder::Module';
10              
11             our $VERSION = "0.10";
12             our @EXPORT = qw(feature runtests Given When Then assert affirm should shouldnt);
13              
14             our @missing_steps = ();
15              
16             my $steps = {};
17             my $feature = {};
18              
19 1     1 0 39 sub feature {
20 1         3 my $caller = caller;
21             my $text = shift;
22 1         25  
23             $feature->{$caller} = Test::Cukes::Feature->new($text)
24             }
25              
26 1     1 0 6 sub runtests {
27 1         2 my $caller = caller;
28             my $feature_text = shift;
29 1 50       4  
30 0         0 if ($feature_text) {
31             $feature->{$caller} = Test::Cukes::Feature->new($feature_text);
32             }
33 1         2  
  1         6  
34             my @scenarios_of_caller = @{$feature->{$caller}->scenarios};
35 1         2  
36 2         4 for my $scenario (@scenarios_of_caller) {
37 2         4 my $skip = 0;
38 2         4 my $skip_reason = "";
39             my $gwt;
40              
41 2         4  
  2         11  
42 8         28 for my $step_text (@{$scenario->steps}) {
43 8 50       18 my ($pre, $step) = split " ", $step_text, 2;
44 0         0 if ($skip) {
45 0         0 Test::Cukes->builder->skip($step_text);
46             next;
47             }
48 8 100       59  
49             $gwt = $pre if $pre =~ /(Given|When|Then)/;
50 8         33  
51 8         25 my $found_step = 0;
52 23         39 for my $step_pattern (keys %$steps) {
53             my $cb = $steps->{$step_pattern}->{code};
54 23 100       326  
55 8         9 if (my (@matches) = $step =~ m/$step_pattern/) {
56             my $ok = 1;
57 8     8   242 try {
58             $cb->(@matches);
59 0     0   0 } catch {
60 8         56 $ok = 0;
61             };
62 8         40314  
63             Test::Cukes->builder->ok($ok, $step_text);
64 8 50 33     3969  
65 0         0 if ($skip == 0 && !$ok) {
66 0         0 Test::Cukes->builder->diag($@);
67 0         0 $skip = 1;
68             $skip_reason = "Failed: $step_text";
69             }
70 8         14  
71 8         17 $found_step = 1;
72             last;
73             }
74             }
75 8 50       34  
76 0         0 unless($found_step) {
77 0         0 $step_text =~ s/^And /$gwt /;
78             push @missing_steps, $step_text;
79             }
80             }
81             }
82              
83             # If the user doesn't specify tests explicitly when they use Test::Cukes;,
84 1 50       7 # assume they had no plan and call done_testing for them.
85             Test::Cukes->builder->done_testing if !Test::Cukes->builder->has_plan;
86 1         304  
87             report_missing_steps();
88 1         107  
89             return 0;
90             }
91              
92 1 50   1 0 6 sub report_missing_steps {
93 0         0 return if @missing_steps == 0;
94 0         0 Test::Cukes->builder->note("There are missing step definitions, fill them in:");
95 0         0 for my $step_text (@missing_steps) {
96 0         0 my ($word, $text) = ($step_text =~ /^(Given|When|Then) (.+)$/);
97 0         0 my $msg = "\n$word qr/${text}/ => sub {\n ...\n};\n";
98             Test::Cukes->builder->note($msg);
99             }
100             }
101              
102 5     5   442 sub _add_step {
103 5         12 my ($step, $cb) = @_;
104             my ($package, $filename, $line) = caller;
105 5         39  
106             $steps->{$step} = {
107             definition => {
108             package => $package,
109             filename => $filename,
110             line => $line,
111             },
112             code => $cb
113             };
114             }
115              
116             *Given = *_add_step;
117             *When = *_add_step;
118             *Then = *_add_step;
119              
120             1;
121             __END__