File Coverage

blib/lib/Test/Import.pm
Criterion Covered Total %
statement 21 52 40.3
branch 0 6 0.0
condition n/a
subroutine 7 15 46.6
pod 4 4 100.0
total 32 77 41.5


line stmt bran cond sub pod time code
1             package Test::Import;
2             {
3             $Test::Import::VERSION = '0.004';
4             }
5             # ABSTRACT: Test functions to ensure modules import things
6              
7 1     1   13581 use strict;
  1         13  
  1         95  
8 1     1   5 use warnings;
  1         1  
  1         86  
9              
10 1     1   42 use base 'Test::Builder::Module';
  1         2  
  1         332  
11 1     1   18 use Test::More;
  1         1  
  1         39  
12 1     1   1816 use Capture::Tiny qw( capture_merged );
  1         38775  
  1         220  
13             our @EXPORT_OK = qw( :all does_import_strict does_import_warnings does_import_sub does_import_class );
14             our %EXPORT_TAGS = (
15             'all' => [ grep { !/^:/ } @EXPORT_OK ], # All is everything except tags
16             );
17              
18              
19             ## no critic ( ProhibitSubroutinePrototypes )
20             sub does_import_strict($) {
21 0     0 1   my ( $module ) = @_;
22 0           my $tb = __PACKAGE__->builder;
23             return $tb->subtest( "$module imports strict" => sub {
24             # disable strict so module has to explicitly re-enable it
25             # pragmas cannot be hidden by a package statement, but some
26             # modules may try to muck around with the calling package,
27             # so hide ourselves from those evil import statements
28             ## no critic ( ProhibitStringyEval ProhibitNoStrict )
29 1     1   9 no strict;
  1         2  
  1         168  
30 0     0     eval qq{package ${module}::strict; use $module; } . q{@m = ( "one" );};
31 0           ok $@, 'code that fails strict dies';
32 0           like $@, qr{explicit package name}, 'dies with the right error message';
33 0           } );
34             }
35              
36              
37             sub does_import_warnings($) {
38 0     0 1   my ( $module ) = @_;
39 0           my $tb = __PACKAGE__->builder;
40             return $tb->subtest( "$module imports warnings" => sub {
41             # disable warnings so module has to explicitly re-enable it
42             # pragmas cannot be hidden by a package statement, but some
43             # modules may try to muck around with the calling package,
44             # so hide ourselves from those evil import statements
45             ## no critic ( ProhibitStringyEval ProhibitNoWarnings )
46 1     1   7 no warnings;
  1         3  
  1         702  
47 0     0     my @warnings;
48 0           local $SIG{__WARN__} = sub { push @warnings, @_ };
  0            
49 0           eval qq{package ${module}::warnings; use $module;} . q{my $foo = "one" . undef;};
50 0           is scalar @warnings, 1, 'got the one warning we expected';
51 0           like $warnings[0], qr/uninitialized/, 'we forced an uninitialized warning';
52 0           } );
53             }
54              
55              
56             sub does_import_sub($$$) {
57 0     0 1   my ( $module, $imported_module, $imported_sub ) = @_;
58 0           my $tb = __PACKAGE__->builder;
59             return $tb->subtest( "$module imports $imported_module sub $imported_sub" => sub {
60             ## no critic ( ProhibitStringyEval )
61 0     0     ok eval "package ${module}::${imported_module}; use $module; return __PACKAGE__->can('$imported_sub')",
62             'eval succeeded and expected sub was imported';
63             ## no critic ( ProhibitMixedBooleanOperators )
64 0 0         ok !$@, 'eval did not throw an error' or diag $@;
65 0           } );
66             }
67              
68              
69             sub does_import_class($$) {
70 0     0 1   my ( $module, $imported_class ) = @_;
71 0           my $tb = __PACKAGE__->builder;
72             return $tb->subtest( "$module imports $imported_class" => sub {
73             # Do the module name to file path dance!
74 0     0     my $imported_path = $imported_class;
75 0           $imported_path =~ s{::}{/}g;
76 0           $imported_path .= '.pm';
77              
78             # Pretend the module has not been loaded
79 0           delete local $INC{$imported_path}; # delete local added in 5.12.0
80              
81             # Capture to hide the warnings about subroutines redefined
82             # Doing 'no warnings qw(redefine)" does not work if the module we're loading
83             # also imports warnings
84             my ( $output, $retval ) = capture_merged {
85             ## no critic ( ProhibitStringyEval )
86 0           return eval "package ${module}::${imported_class}; use $module; return exists \$INC{'$imported_path'}";
87 0           };
88 0 0         ok $retval, 'eval succeeded and expected path exists in %INC' or diag $output;
89             ## no critic ( ProhibitMixedBooleanOperators )
90 0 0         ok !$@, 'eval did not throw an error' or diag $@;
91 0           } );
92             }
93              
94             1;
95              
96             __END__