view release on metacpan or  search on metacpan

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

use 5.006;

package Test::DiagINC;
# ABSTRACT: List modules and versions loaded if tests fail

our $VERSION = '0.010';

# If the tested module did not load strict/warnings we do not want
# to load them either. On the other hand we would like to know our
# code is at least somewhat ok. Therefore this madness ;)
BEGIN {
    if ( $ENV{RELEASE_TESTING} ) {
        require warnings && warnings->import;
        require strict   && strict->import;
    }
}

sub _max_length {
    my $max = 0;
    do { $max = length if length > $max }
      for @_;
    return $max;
}

# Get our CWD *without* loading anything. Original idea by xdg++
# ribasushi thinks this is fragile and will break sooner rather than
# later, but adding it as is because haarg and xdg both claim it's fine.
# Requires %ENV cleanup to work under taint mode
my $REALPATH_CWD = do {
    local $ENV{PATH};
    delete $ENV{PATH};
    local $ENV{IFS};
    delete $ENV{IFS};
    local $ENV{CDPATH};
    delete $ENV{CDPATH};
    local $ENV{ENV};
    delete $ENV{ENV};
    local $ENV{BASH_ENV};
    delete $ENV{BASH_ENV};
    my ($perl) = $^X =~ /(.+)/; # $^X is internal how could it be tainted?!
    `"$perl" -MCwd -le "print getcwd"`;
};
chomp $REALPATH_CWD;

my $ORIGINAL_PID = $$;

END {
    if ( $$ == $ORIGINAL_PID ) {
        # make sure we report only on stuff that was loaded by the test,
        # nothing more
        # get a snapshot early in order to not misreport B.pm and friends
        # below - this *will* skip any extra modules loaded in END, it was
        # deemed an acceptable compromise by ribasushi and xdg
        my @INC_list = keys %INC;

        # If we meet the "fail" criteria - no need to load B and fire
        # an extra check in an extra END (also doesn't work on 5.6)
        if ( _assert_no_fail(@INC_list) and $] >= 5.008 ) {

            # we did not report anything yet - add an extra END to catch
            # possible future-fails
            require B;
            push @{ B::end_av()->object_2svref }, sub {
                _assert_no_fail(@INC_list);
            };
        }
    }
}

# Dump %INC IFF in the main process and test is failing or exit is non-zero
# return true if no failure or if PID mismatches, return false otherwise
sub _assert_no_fail {

    return 1 if $$ != $ORIGINAL_PID;