File Coverage

blib/lib/Test/Name/FromLine.pm
Criterion Covered Total %
statement 36 36 100.0
branch 5 6 83.3
condition 4 5 80.0
subroutine 8 8 100.0
pod n/a
total 53 55 96.3


line stmt bran cond sub pod time code
1             package Test::Name::FromLine;
2              
3 6     6   308421 use strict;
  6         16  
  6         238  
4 6     6   34 use warnings;
  6         12  
  6         340  
5              
6             our $VERSION = '0.13';
7              
8 6     6   31 use Test::Builder;
  6         16  
  6         124  
9 6     6   7643 use File::Slurp;
  6         155754  
  6         1161  
10 6     6   67 use File::Spec;
  6         12  
  6         140  
11 6     6   115 use Cwd qw(getcwd);
  6         9  
  6         556  
12              
13             our $BASE_DIR = getcwd();
14             our %filecache;
15              
16 6     6   35 no warnings 'redefine';
  6         13  
  6         2616  
17             my $ORIGINAL_ok = \&Test::Builder::ok;
18             *Test::Builder::ok = sub {
19 18     18   89037 @_ = @_; # for pass and fail
20 18         32 $_[2] = do {
21 18         121 my ($package, $filename, $line) = caller($Test::Builder::Level);
22 18 50 66     132 undef $filename if $filename && $filename eq '-e';
23 18 100       48 if ($filename) {
24 17         666 $filename = File::Spec->rel2abs($filename, $BASE_DIR);
25 17   100     117 my $file = $filecache{$filename} ||= [ read_file($filename) ];
26 17         1689 my $lnum = $line;
27 17         36 $line = $file->[$lnum-1];
28 17         211 $line =~ s{^\s+|\s+$}{}g;
29 17 100       376 if ($_[2]) {
30 9         34 "L$lnum: $_[2]";
31             } else {
32 8         35 "L$lnum: $line";
33             }
34             } else {
35 1         3 ""; # invalid $Test::Builder::Level
36             }
37             };
38 18         93 goto &$ORIGINAL_ok;
39             };
40              
41              
42             1;
43             __END__