File Coverage

blib/lib/Test2/Plugin/SpecDeclare.pm
Criterion Covered Total %
statement 75 78 96.1
branch 18 24 75.0
condition 4 6 66.6
subroutine 9 9 100.0
pod 0 2 0.0
total 106 119 89.0


line stmt bran cond sub pod time code
1             package Test2::Plugin::SpecDeclare;
2 5     5   372880 use strict;
  5         7  
  5         113  
3 5     5   17 use warnings;
  5         3  
  5         91  
4              
5 5     5   2293 use Devel::Declare;
  5         16966  
  5         15  
6 5     5   2227 use B::Hooks::EndOfScope;
  5         37858  
  5         25  
7              
8 5     5   266 use Carp qw/croak/;
  5         5  
  5         2825  
9              
10             our $VERSION = '0.000002';
11              
12             sub import {
13 5     5   362 my $class = shift;
14 5         7 my $into = caller;
15              
16 5         5 my @keywords;
17             my %params;
18 5         13 for my $arg (@_) {
19 1 50       4 if ($arg =~ m/^-(.+)$/) {
20 0         0 $params{$1} = 1;
21 0         0 next;
22             }
23 1         2 push @keywords => $arg;
24             }
25              
26 5 100 66     39 if(delete $params{spec} || !@_) {
27 4         4 my %seen;
28 4 50       8 push @keywords => grep { !$seen{$_}++ && $into->can($_) }
  84         320  
29             @Test2::Tools::Spec::EXPORT,
30             @Test2::Tools::Spec::EXPORT_OK;
31             }
32              
33 5 50       17 croak "Unknown parameter(s): " . join(',', map { "-$_" } keys %params)
  0         0  
34             if keys %params;
35              
36 5 50       14 croak "No keywords (Did you forget to load Test2::Tools::Spec, or specify a list of keywords?)"
37             unless @keywords;
38              
39             Devel::Declare->setup_for(
40             $into,
41 5         8 {map { $_ => {const => \&parser} } @keywords},
  73         123  
42             );
43             }
44              
45             sub inject {
46             on_scope_end {
47 55     55   1268 my $linestr = Devel::Declare::get_linestr;
48 55         67 my $offset = Devel::Declare::get_linestr_offset;
49 55         83 substr($linestr, $offset, 0) = ', __LINE__;';
50 55         95 Devel::Declare::set_linestr($linestr);
51 55     55 0 1998 };
52             }
53              
54             sub parser {
55 63     63 0 2257 my ($declarator, $offset) = @_;
56 63         312 my @caller = caller(1);
57              
58             # Skip the declarator
59 63         110 $offset += Devel::Declare::toke_move_past_token($offset);
60 63         81 $offset += Devel::Declare::toke_skipspace($offset);
61 63         89 my $line = Devel::Declare::get_linestr();
62              
63 63         39 my $name;
64 63         54 my $name_offset = $offset;
65 63         36 my $name_len;
66              
67             # Get the block name
68 63         70 my $start = substr($line, $offset, 1);
69 63 100 66     306 if ($start eq '(') {
    100          
    50          
70             # No changes
71 1         8 return;
72             }
73             elsif ($start eq '"' || $start eq "'") {
74             # Quoted name
75 1         4 $name_len = Devel::Declare::toke_scan_str($offset);
76 1         2 $name = Devel::Declare::get_lex_stuff();
77 1         2 Devel::Declare::clear_lex_stuff();
78 1         1 $offset += $name_len;
79             }
80             elsif ($name_len = Devel::Declare::toke_scan_word($offset, 1)) {
81             # Bareword name
82 61         70 $name = substr($line, $offset, $name_len);
83 61         55 $offset += $name_len;
84             }
85              
86 62         64 $offset += Devel::Declare::toke_skipspace($offset);
87 62         69 $line = Devel::Declare::get_linestr();
88              
89 62         95 my $meta = "";
90 62         46 my $meta_offset;
91             my $meta_len;
92              
93 62         47 $start = substr($line, $offset, 1);
94 62 100       102 if ($start eq '(') {
95 14         14 $meta_offset = $offset;
96 14         67 $meta_len = Devel::Declare::toke_scan_str($offset);
97 14         24 $meta = Devel::Declare::get_lex_stuff();
98 14         16 Devel::Declare::clear_lex_stuff();
99 14         18 $line = Devel::Declare::get_linestr();
100              
101 14 50       38 die "Syntax error at $caller[1] line $caller[2]: Test2::Plugin::SpecDeclare does not support multiline parameters.\n"
102             if $meta =~ m/\n/;
103              
104 14         10 $offset += $meta_len;
105 14         19 $offset += Devel::Declare::toke_skipspace($offset);
106 14         24 $line = Devel::Declare::get_linestr();
107 14         15 $start = substr($line, $offset, 1);
108             }
109              
110             # No changes
111 62 100       114 return unless $start eq '{';
112              
113             # Ok! we are good to munge this thing!
114 55         58 substr($line, $offset, 1) = " sub { BEGIN { Test2::Plugin::SpecDeclare::inject() }; ";
115              
116 55 100       80 if ($meta) {
117 14         18 substr($line, $meta_offset + $meta_len - 1, 1) = '}, ';
118 14         14 substr($line, $meta_offset, 1) = ' +{';
119             }
120              
121 55         57 substr($line, $name_offset + $name_len, 0) = ' => __LINE__, ';
122              
123 55         62 Devel::Declare::set_linestr($line);
124 55         239 $line = Devel::Declare::get_linestr();
125             }
126              
127             1;
128              
129             __END__