view release on metacpan or  search on metacpan

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

BEGIN {

    require Test::More;
    if (Test::More->can('TB_PROVIDER_META')) {
        Test::More->import(import => [ '!explain' ]);
    }
    else {
        # There's some strange fiddling around with import(), so this allows us to
        # be nicely backwards compatible to earlier versions of Test::More.
        local @Test::More::EXPORT = grep { $_ ne 'explain' } @Test::More::EXPORT;
        Test::More->import;
    }

    eval "use Time::HiRes";
    $HAVE_TIME_HIRES = 1 unless $@;
}

use Test::Builder;
my $OK_FUNC;
BEGIN {
    $OK_FUNC = \&Test::Builder::ok;
}

our $VERSION = '0.42';
$VERSION = eval $VERSION;

BEGIN {
    @ISA    = qw(Test::Builder::Module);
    @EXPORT = (
        Test::More->can('TB_PROVIDER_META')
            ? grep { $_ ne 'TODO' } keys( %{Test::More->TB_PROVIDER_META->{attrs}})
            : @Test::More::EXPORT,
        qw<
            $TODO
            all_done
            bail_on_fail
            die_on_fail
            explain
            always_explain
            last_test_failed
            restore_fail
            set_failure_handler
            show
            always_show
        >
    );
}

sub import {
    my $class = shift;
    my $bail_set = 0;
    local @EXPORT = @EXPORT; # localize effect of %exclude_symbol

    my %modules_to_load = map { $_ => 1 } qw/
        Test::Differences
        Test::Exception
        Test::Deep
        Test::Warn
    /;
    warnings->import;
    strict->import;
    eval "use Data::Dumper::Names 0.03";
    $DATA_DUMPER_NAMES_INSTALLED = !$@;

    if ( $ENV{BAIL_ON_FAIL} ) {
        $bail_set = 1;
        bail_on_fail();
    }
    if ( !$bail_set and $ENV{DIE_ON_FAIL} ) {
        die_on_fail();
    }
    for my $i ( 0 .. $#_ ) {
        if ( 'bail' eq $_[$i] ) {
            splice @_, $i, 1;
            bail_on_fail();
            $bail_set = 1;
            last;
        }
    }
    my $caller = caller;
    for my $i ( 0 .. $#_ ) {
        if ( 'timeit' eq $_[$i] ) {
            splice @_, $i, 1;
            no strict;
            *{"${caller}::timeit"} = \&timeit;
            last;
        }
    }

    my %exclude_symbol;
    my $i = 0;

    # Pull out `import => [...]` so it doesn't fall through to plan(), which
    # doesn't understand it. The list drives export_to_level below.
    #
    # The while-with-index loop is intentional: we mutate @_ via splice as
    # we go, and this matches the existing parser further down the sub.
    my @explicit;
    while ( $i < @_ ) {
        if ( $_[$i] eq 'import' && ref $_[ $i + 1 ] eq 'ARRAY' ) {
            @explicit = @{ ( splice @_, $i, 2 )[1] };
            last;
        }
        $i++;
    }
    $i = 0;

    foreach my $do_not_import_by_default (qw/blessed reftype/) {
        if ( grep { $_ eq $do_not_import_by_default } @_, @explicit ) {
            @_ = grep { $_ ne $do_not_import_by_default } @_;
            # If the user opted in positionally AND used import => [...],
            # the explicit list is the export source — make sure the symbol
            # is in it, or it would be silently dropped.
            if ( @explicit
                && !grep { $_ eq $do_not_import_by_default } @explicit ) {
                push @explicit, $do_not_import_by_default;
            }
        }
        else {
            $exclude_symbol{$do_not_import_by_default} = 1;
        }