line | stmt | bran | cond | sub | pod | time | code |
1 | | | | | | | #line 1 |
2 | | | | | | | package Test::Builder::Module; |
3 | |
4 | | | | | | | use strict; |
5 | |
6 | | | | | | | use Test::Builder; |
7 | |
8 | | | | | | | require Exporter; |
9 | | | | | | | our @ISA = qw(Exporter); |
10 | |
11 | | | | | | | our $VERSION = '0.80'; |
12 | |
13 | | | | | | | # 5.004's Exporter doesn't have export_to_level. |
14 | | | | | | | my $_export_to_level = sub { |
15 | | | | | | | my $pkg = shift; |
16 | | | | | | | my $level = shift; |
17 | | | | | | | (undef) = shift; # redundant arg |
18 | | | | | | | my $callpkg = caller($level); |
19 | | | | | | | $pkg->export($callpkg, @_); |
20 | | | | | | | }; |
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 | |
46 | | | | | | | sub _strip_imports { |
47 | | | | | | | my $class = shift; |
48 | | | | | | | my $list = shift; |
49 | |
50 | | | | | | | my @imports = (); |
51 | | | | | | | my @other = (); |
52 | | | | | | | my $idx = 0; |
53 | | | | | | | while( $idx <= $#{$list} ) { |
54 | | | | | | | my $item = $list->[$idx]; |
55 | |
56 | | | | | | | if( defined $item and $item eq 'import' ) { |
57 | | | | | | | push @imports, @{$list->[$idx+1]}; |
58 | | | | | | | $idx++; |
59 | | | | | | | } |
60 | | | | | | | else { |
61 | | | | | | | push @other, $item; |
62 | | | | | | | } |
63 | |
64 | | | | | | | $idx++; |
65 | | | | | | | } |
66 | |
67 | | | | | | | @$list = @other; |
68 | |
69 | | | | | | | return @imports; |
70 | | | | | | | } |
71 | |
72 | |
73 | | | | | | | #line 147 |
74 | |
75 | | | | | | | sub import_extra {} |
76 | |
77 | |
78 | | | | | | | #line 178 |
79 | |
80 | | | | | | | sub builder { |
81 | | | | | | | return Test::Builder->new; |
82 | | | | | | | } |
83 | |
84 | |
85 | | | | | | | 1; |