view release on metacpan or  search on metacpan

lib/Test/Kit.pm  view on Meta::CPAN

use Import::Into;
use Module::Runtime 'use_module', 'module_notional_filename';
use Sub::Delete;
use Test::Builder ();
use Test::More ();
use Scalar::Util qw(refaddr);
use Hook::LexWrap qw(wrap);

use parent 'Exporter';
our @EXPORT = ('include');
# my %test_kits_cache = (
#     'MyTest::Awesome' => {
#         'ok' => { source => [ 'Test::More' ], refaddr => 0x1234, },
#         'pass' => { source => [ 'Test::Simple', 'Test::More' ], refaddr => 0xbeef, },
#         'warnings_are' => { source => [ 'Test::Warn' ], refaddr => 0xbead, },
#         ...
#     },
#     ...
# )
#
my %test_kits_cache;

sub include {
    my @to_include = @_;

    my $class = __PACKAGE__;

    my $include_hashref;
    if (grep { ref($_) } @to_include) {
        $include_hashref = { @to_include };
    }
    else {
        $include_hashref = { map { $_ => {} } @to_include };
    }

    return $class->_include($include_hashref);
}

sub _include {
    my $class = shift;
    my $include_hashref = shift;

    my $target = $class->_get_package_to_import_into();

    $class->_make_target_a_test_more_like_exporter($target);

    for my $package (sort keys %$include_hashref) {
        # special cases for strict and warnings on pre-1.3 Test::Builder
        #
        # The logic here is copied from Moose which always causes strict and
        # warnings to be enabled when it is used.
        #
        # A comment in Moose::Exporter states:
        #
        # "this works because both pragmas set $^H (see perldoc perlvar) which
        # affects the current compilation - i.e. the file who use'd us - which
        # is why we don't need to do anything special to make it affect that
        # file rather than this one (which is already compiled)"
        #
        # In the Moose code the author simply calls strict->import() in the
        # appropriate import() method and that does the trick. For us working
        # at a bit more of a distance we have to be a bit trickier - adding
        # strict->import() or warnings->import() to the import method on the
        # target class. We do that by wrapping it with Hook::LexWrap::wrap().
        #
        if ($Test::Builder::VERSION < 1.3 && ($package eq 'strict' || $package eq 'warnings')) {
            wrap "${target}::import", post => sub { $package->import(); };
        }
        else {
            my $fake_package = $class->_create_fake_package($package, $include_hashref->{$package}, $target);
            $fake_package->import::into($target);
        }
    }

    $class->_update_target_exports($target);

    return;
}

sub _get_package_to_import_into {
    my $class = shift;

    # so, as far as I can tell, on Perl 5.14 and 5.16 at least, we have the
    # following callstack...
    #
    # 1. Test::Kit
    # 2. MyTest
    # 3. main
    # 4. main
    # 5. main
    #
    # ... and we want to get the package name "MyTest" out of there.
    # So let's look for the first non-Test::Kit result

    for my $i (1 .. 20) {
        my $caller_package = (caller($i))[0];
        if ($caller_package ne $class) {
            return $caller_package;
        }
    }

    die "Unable to find package to import into";
}

sub _make_target_a_test_more_like_exporter {
    my $class = shift;
    my $target = shift;

    return if $test_kits_cache{$target};

    $class->_check_target_does_not_import($target);

    {
        no strict 'refs';
        push @{ "${target}::ISA" }, 'Test::Builder::Module';

        # need to explicitly do this so that if we need to wrap import()
        # for strict and warnings includes it already exists at the right
        # point.
        *{ "${target}::import" } = \&Test::Builder::Module::import;
    }

    $test_kits_cache{$target} = {};