view release on metacpan or  search on metacpan

lib/Test2/Tools/LoadModule.pm  view on Meta::CPAN

package Test2::Tools::LoadModule;

use 5.008001;

use strict;
use warnings;

# OK, the following is probably paranoia. But if Perl 7 decides to
# change this particular default I'm ready. Unless they eliminate $].
no if $] ge '5.020', feature => qw{ signatures };

use Carp;
use Exporter 5.567;	# Comes with Perl 5.8.1.
# use File::Find ();
# use File::Spec ();
# use Getopt::Long 2.34;	# Comes with Perl 5.8.1.
use Test2::API 1.302096 ();
use Test2::API::Context 1.302096 ();	# for pass_and_release().
use Test2::Util 1.302096 ();

use base qw{ Exporter };

our $VERSION = '0.009';
$VERSION =~ s/ _ //smxg;

{
    my @test2 = qw{
	all_modules_tried_ok
	clear_modules_tried
	load_module_ok
	load_module_or_skip
	load_module_or_skip_all
    };

    my @more = qw{
	require_ok
	use_ok
    };

    my @private = qw{
	__build_load_eval
	__get_hint_hash
	DEFAULT_LOAD_ERROR
	ERR_IMPORT_BAD
	ERR_MODULE_UNDEF
	ERR_OPTION_BAD
	ERR_SKIP_NUM_BAD
	ERR_VERSION_BAD
	HINTS_AVAILABLE
	TEST_MORE_ERROR_CONTEXT
	TEST_MORE_LOAD_ERROR
    };

    our @EXPORT_OK = ( @test2, @more, @private );

    our %EXPORT_TAGS = (
	all		=> [ @test2, @more ],
	default	=> \@test2,
	more	=> \@more,
	private	=> \@private,
	test2	=> \@test2,
    );

    our @EXPORT = @{ $EXPORT_TAGS{default} };	## no critic (ProhibitAutomaticExportation)
}

use constant ARRAY_REF		=> ref [];
use constant HASH_REF		=> ref {};

use constant CALLER_HINT_HASH	=> 10;

use constant DEFAULT_LOAD_ERROR	=> '%s';

use constant ERR_IMPORT_BAD	=>
	'Import list must be an array reference, or undef';
use constant ERR_MODULE_UNDEF	=> 'Module name must be defined';
use constant ERR_OPTION_BAD	=> 'Bad option';
use constant ERR_SKIP_NUM_BAD	=>
	'Number of skipped tests must be an unsigned integer';
use constant ERR_VERSION_BAD	=> q/Version '%s' is invalid/;

use constant HINTS_AVAILABLE	=> $] ge '5.010';

# The following cribbed shamelessly from version::regex 0.9924,
# after being munged to suit by tools/version_regex 0.000_010.
# This technical debt is incurred to avoid having to require a version
# of the version module large enough to export the is_lax() subroutine.
use constant LAX_VERSION	=> qr/(?x: (?x:
	v (?-x:[0-9]+) (?-x: (?-x:\.[0-9]+)+ (?-x:_[0-9]+)? )?
	|
	(?-x:[0-9]+)? (?-x:\.[0-9]+){2,} (?-x:_[0-9]+)?
    ) | (?x: (?-x:[0-9]+) (?-x: (?-x:\.[0-9]+) | \. )? (?-x:_[0-9]+)?
	|
	(?-x:\.[0-9]+) (?-x:_[0-9]+)?
    ) )/;

use constant TEST_MORE_ERROR_CONTEXT	=> q/Tried to %s '%s'./;
use constant TEST_MORE_LOAD_ERROR	=> 'Error:  %s';
use constant TEST_MORE_OPT		=> {
    load_error	=> TEST_MORE_LOAD_ERROR,
    require	=> 1,
};

{
    my %module_tried;

    sub load_module_ok (@) {	## no critic (RequireArgUnpacking)
	my @arg = _validate_args( 0, @_ );

	# We do this now in case _load_module_ok() throws an uncaught
	# exception, just so we have SOME record we tried.
	$module_tried{ $arg[1] } = undef;

	my $ctx = Test2::API::context();

	my $rslt = _load_module_ok( @arg );

	$module_tried{ $arg[1] } = $rslt;

	$ctx->release();

	return $rslt;
    }

    sub all_modules_tried_ok (@) {
	my @where = @_;
	@where
	    or @where = ( 'blib/lib', 'blib/arch' );

	require File::Find;
	require File::Spec;

	my @not_tried;
	foreach my $d ( @where ) {
	    File::Find::find( sub {
		    m/ [.] pm \z /smx
			or return;
		    my ( undef, $dir, $name ) = File::Spec->splitpath(
			File::Spec->abs2rel( $File::Find::name, $d ) );
		    my @dir = File::Spec->splitdir( $dir );
		    $dir[-1]
			or pop @dir;