view release on metacpan or  search on metacpan

t/Kit.pm  view on Meta::CPAN

# -*- perl -*-

# Kit.pm: test kit for Sub::Multi::Tiny
package # hide from PAUSE
    Kit;

use 5.006;
use strict;
use warnings;

use parent 'Exporter';
use vars::i '@EXPORT' => qw(fails_ok find_file_in_t get_perl_filename here
                            is_covering run_perl true false);

use Config;
use Cwd 'abs_path';
use Data::Dumper;
use File::Spec;
use Import::Into;
use IPC::Run3;
use Test::More;

# is_covering: is Devel::Cover running?
sub is_covering {
    return !!(eval 'Devel::Cover::get_coverage()');
} #is_covering()

# Set verbosity:
#   - on for coverage of _hlog statements
#   - on for debugging of test failures in <5.18    XXX DEBUG
# Note that verbosity will also be on if $ENV{SUB_MULTI_TINY_VERBOSE} is set.
use Sub::Multi::Tiny::Util '*VERBOSE';
BEGIN {
    $VERBOSE = 99 if is_covering || $] lt '5.018';
}

use constant {
    true => !!1,
    false => !!0,
};


# Get the filename of the Perl interpreter running this. {{{1
# Modified from perlvar.
# The -x test is for cygwin or other systems where $Config{perlpath} has no
# extension and $Config{_exe} is nonempty.  E.g., symlink perl->perl5.10.1.exe.
# There is no "perl.exe" on such a system.
sub get_perl_filename {
    my $secure_perl_path = $Config{perlpath};
    if ($^O ne 'VMS') {
        $secure_perl_path .= $Config{_exe}
            unless (-x $secure_perl_path) ||
                            ($secure_perl_path =~ m/$Config{_exe}$/i);
    }
    die "Could not find perl interpreter" unless $secure_perl_path;
    return $secure_perl_path;
} # get_perl_filename()

# }}}1

# find_file_in_t($filename[, checks]).  Assumes caller is in t/.
sub find_file_in_t {
    my (undef, $filename) = caller;

    my $here = abs_path($filename);
    die "Could not find my file location: $!" unless defined $here;
    my ($volume,$directories,undef) = File::Spec->splitpath( $here );

    my $pl_file = File::Spec->catpath(
        $volume,
        $directories,
        shift
    );

    # File tests, if requested.
    foreach(@_) {
        die "Can not read $pl_file" if $_ eq 'r' && !( -f $pl_file && -r _);
        die "Can not write $pl_file" if $_ eq 'w' && !( -w $pl_file );
        die "Can not execute $pl_file" if $_ eq 'x' && !( -f $pl_file && -x _);
    }

    return $pl_file;
} #find_file_in_t

# ($out, $err, $exitstatus) = run_perl(args arrayref, [$stdin text if any])
sub run_perl {
    my $perl = get_perl_filename;
    my ($lrArgs, $in) = @_;
    $in = '' unless defined $in;
    my ($out, $err);

    # Check if we are running under cover(1) from Devel::Cover
    diag is_covering() ? 'Devel::Cover running' : 'Devel::Cover not covering';