File Coverage

inc/Test/Builder/Module.pm
Criterion Covered Total %
statement 29 33 87.8
branch 3 4 75.0
condition 1 3 33.3
subroutine 5 6 83.3
pod 2 2 100.0
total 40 48 83.3


line stmt bran cond sub pod time code
1             #line 1
2             package Test::Builder::Module;
3             # $Id$
4 6     6   34  
  6         13  
  6         344  
5             use strict;
6 6     6   8817  
  6         20  
  6         4215  
7             use Test::Builder;
8              
9             require Exporter;
10             our @ISA = qw(Exporter);
11              
12             our $VERSION = '0.86';
13              
14             # 5.004's Exporter doesn't have export_to_level.
15             my $_export_to_level = sub {
16             my $pkg = shift;
17             my $level = shift;
18             (undef) = shift; # redundant arg
19             my $callpkg = caller($level);
20             $pkg->export( $callpkg, @_ );
21             };
22              
23             #line 82
24              
25             sub import {
26             my($class) = shift;
27              
28             # Don't run all this when loading ourself.
29             return 1 if $class eq 'Test::Builder::Module';
30              
31             my $test = $class->builder;
32              
33             my $caller = caller;
34              
35             $test->exported_to($caller);
36              
37             $class->import_extra( \@_ );
38             my(@imports) = $class->_strip_imports( \@_ );
39              
40             $test->plan(@_);
41              
42             $class->$_export_to_level( 1, $class, @imports );
43             }
44              
45             sub _strip_imports {
46             my $class = shift;
47             my $list = shift;
48              
49             my @imports = ();
50             my @other = ();
51             my $idx = 0;
52             while( $idx <= $#{$list} ) {
53             my $item = $list->[$idx];
54              
55             if( defined $item and $item eq 'import' ) {
56             push @imports, @{ $list->[ $idx + 1 ] };
57             $idx++;
58             }
59             else {
60             push @other, $item;
61             }
62              
63             $idx++;
64             }
65              
66             @$list = @other;
67              
68             return @imports;
69             }
70              
71             #line 145
72              
73             sub import_extra { }
74              
75             #line 175
76              
77             sub builder {
78             return Test::Builder->new;
79             }
80              
81             1;