view release on metacpan or  search on metacpan

t/MaybeMaketextTestdata.pm  view on Meta::CPAN

        $faultmessage = sprintf( '- %s: Unable to set as parent localizer due to %s', $package_name, $faultmessage );
        $loaders[ $self->{'index'} ]->{'fullfaultmessage'} = $faultmessage;
    }

    return $loaders[ $self->{'index'} ]->{'fullfaultmessage'};
}

# If in a test_data_iterator iterator or get_test_data_by_index, then return the current test
# full INC path.
sub get_inc ($self) {
    if ( !defined( $self->{'index'} ) ) {
        croak('Missing index');
    }
    return ( $self->get_mock(), $base_root );
}

# If in a test_data_iterator iterator or get_test_data_by_index, then return the current test
# "path to use in INC queries".
sub get_path ($self) {
    if ( !defined( $self->{'index'} ) ) {
        croak('Missing index');
    }
    if ( !defined( $loaders[ $self->{'index'} ]->{'path'} ) ) {
        my $package_name = $self->get_name();
        $loaders[ $self->{'index'} ]->{'path'} = ( $package_name =~ tr{:}{\/}rs ) . '.pm';
    }
    return $loaders[ $self->{'index'} ]->{'path'};
}

# If in a test_data_iterator iterator or get_test_data_by_index, then return true (1) if
# the current test package requires the "INC" path to be set to undef for testing.
sub is_undef_needed_for_fault ($self) {
    if ( !defined( $self->{'index'} ) ) {
        croak('Missing index');
    }
    if ( defined( $loaders[ $self->{'index'} ]->{'use_undef_for_fault'} ) ) {
        return 1;
    }
    return 0;
}

# Unload any previously loaded Maketext libraries.
sub unload_mocks() {
    my $next = test_data_iterator();
    while ( my $package = $next->() ) {
        my $path = $package->get_path();
        if ( defined( $INC{$path} ) ) {
            delete $INC{$path};
            no strict 'refs';    ## no critic (TestingAndDebugging::ProhibitNoStrict)
            undef *{ $package->get_name() . '::get_handle' };
            undef *{ $package->get_name() . '::maketext' };
        }
    }
    return 1;
}

# Automatically import warnings, strict and signature settings to the calling module.
sub import {    ## no critic (Subroutines::RequireArgUnpacking)

    warnings::warnings->import();
    strict::strict->import();
    feature->import(qw/:5.20 signatures/);

    warnings::warnings->unimport(qw/experimental::signatures/);
    MaybeMaketextTestdata->export_to_level( 1, @_ );
    return;
}

# Check all the isas are correctly set - but actually report back which ones are missing.
sub isa_check ( $handle, $packages_ref, $reason ) {
    my %failures = ();
    my @packages = @{$packages_ref};
    for my $key (@packages) {
        if ( !$handle->isa($key) ) {
            $failures{$key} = 1;
        }
    }
    if (%failures) {
        my @diagnose = ();
        for my $key (@packages) {
            if ( $failures{$key} ) {
                push @diagnose, isa_diagnose( 'Failed ISA', $key );
            }
            else {
                push @diagnose, isa_diagnose( 'Passed ISA', $key );
            }
        }
        diag( join( "\n", @diagnose ) );
        fail(
            sprintf(
                '%s: Failed due to %s not having package(s)',
                $reason,
                ref($handle) || $handle
            )
        );
    }
    pass($reason);
    return 1;
}

# If a package isn't supported, try and diagnose why.
sub isa_diagnose ( $state, $package_name ) {
    my $path        = ( $package_name =~ tr{:}{\/}rs ) . '.pm';
    my $inc_results = (
        exists( $INC{$path} )
        ? (
            defined( $INC{$path} )
            ? (
                ref( $INC{$path} )
                ? 'loaded by hook'
                : sprintf( 'loaded by filesystem from "%s"', $INC{$path} )
              )
            : 'raised error/warning on load'
          )
        : 'not loaded'
    );
    return sprintf( '%s - %s : %s (%s)', $state, $package_name, $inc_results, $path );
}

1;