Created
April 7, 2014 18:39
-
-
Save preaction/10028106 to your computer and use it in GitHub Desktop.
Test::Import - Test that the appropriate imports are happening
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package Test::Imports; [9/680] | |
use strict; | |
use warnings; | |
use base 'Test::Builder::Module'; | |
use Test::More; | |
use Capture::Tiny qw( capture_merged ); | |
our @EXPORT_OK = qw( :all does_import_strict does_import_warnings does_import_sub does_import_class); | |
our %EXPORT_TAGS = ( | |
'all' => [ grep { !/^:/ } @EXPORT_OK ], # All is everything except tags | |
); | |
## no critic ( ProhibitSubroutinePrototypes ) | |
sub does_import_strict($) { | |
my ( $module ) = @_; | |
my $tb = __PACKAGE__->builder; | |
return $tb->subtest( "$module imports strict" => sub { | |
# disable strict so module has to explicitly re-enable it | |
# pragmas cannot be hidden by a package statement, but some | |
# modules may try to muck around with the calling package, | |
# so hide ourselves from those evil import statements | |
## no critic ( ProhibitStringyEval ProhibitNoStrict ) | |
no strict; | |
eval qq{package ${module}::strict; use $module; } . q{@m = ( "one" );}; | |
ok $@, 'code that fails strict dies'; | |
like $@, qr{explicit package name}, 'dies with the right error message'; | |
} ); | |
} | |
sub does_import_warnings($) { | |
my ( $module ) = @_; | |
my $tb = __PACKAGE__->builder; | |
return $tb->subtest( "$module imports warnings" => sub { | |
# disable warnings so module has to explicitly re-enable it | |
# pragmas cannot be hidden by a package statement, but some | |
# modules may try to muck around with the calling package, | |
# so hide ourselves from those evil import statements | |
## no critic ( ProhibitStringyEval ProhibitNoWarnings ) | |
no warnings; | |
my @warnings; | |
local $SIG{__WARN__} = sub { push @warnings, @_ }; | |
eval qq{package ${module}::warnings; use $module;} . q{my $foo = "one" . undef;}; | |
is scalar @warnings, 1, 'got the one warning we expected'; | |
like $warnings[0], qr/uninitialized/, 'we forced an uninitialized warning'; | |
} ); | |
} | |
sub does_import_sub($$$) { | |
my ( $module, $imported_module, $imported_sub ) = @_; | |
my $tb = __PACKAGE__->builder; | |
return $tb->subtest( "$module imports $imported_module sub $imported_sub" => sub { | |
## no critic ( ProhibitStringyEval ) | |
ok eval "package ${module}::${imported_module}; use $module; return __PACKAGE__->can('$imported_sub')", | |
'eval succeeded and expected sub was imported'; | |
## no critic ( ProhibitMixedBooleanOperators ) | |
ok !$@, 'eval did not throw an error' or diag $@; | |
} ); | |
} | |
sub does_import_class($$) { | |
my ( $module, $imported_class ) = @_; | |
my $tb = __PACKAGE__->builder; | |
return $tb->subtest( "$module imports $imported_class" => sub { | |
# Do the module name to file path dance! | |
my $imported_path = $imported_class; | |
$imported_path =~ s{::}{/}g; | |
$imported_path .= '.pm'; | |
# Pretend the module has not been loaded | |
delete local $INC{$imported_path}; # delete local added in 5.12.0 | |
# Capture to hide the warnings about subroutines redefined | |
# Doing 'no warnings qw(redefine)" does not work if the module we're loading | |
# also imports warnings | |
my ( $output, $retval ) = capture_merged { | |
## no critic ( ProhibitStringyEval ) | |
return eval "package ${module}::${imported_class}; use $module; return exists \$INC{'$imported_path'}"; | |
}; | |
ok $retval, 'eval succeeded and expected path exists in %INC' or diag $output; | |
## no critic ( ProhibitMixedBooleanOperators ) | |
ok !$@, 'eval did not throw an error' or diag $@; | |
} ); | |
} | |
1; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment