use strict;
use warnings;
use Test::More;
use Test::Deep;
use File::Temp qw/tempfile/;
use YAML qw/LoadFile/;
use lib qw(t/lib);
use Test::SyntheticModule qw/make_module/;
use constant HAS_F => $] >= 5.009002
|| ( $] >= 5.008007 && $] < 5.009000 );
my $PERL = $^X;
my @INCLUDE = map { "-I$_" } @INC[ 0 .. 3 ]; # Fragile
# Protect from modules loaded in PERL5OPT
local $ENV{PERL5OPT};
my @schedule;
{
my $dump_file = undef;
sub dump_file {
unless ( defined $dump_file ) {
( undef, $dump_file ) = tempfile( UNLINK => 1 );
}
return $dump_file;
}
}
BEGIN {
my $is_syn_package = re( qr{ ^ Synthetic::\w+ $}x );
@schedule = ( {
name => 'Summary',
options => 'stdout,summary',
setup => sub {
my $module = make_module( '' );
return "use $module";
},
stdout => [
'',
'Loaded Modules Cross Reference',
'==============================',
'',
$is_syn_package,
' -e (main), line 1',
'',
'Required versions',
'=================',
'',
'No versions required'
]
},
{
name => 'YAML',
options => 'yaml,dump',
setup => sub {
my $dump = dump_file();
my $module = make_module(
"Devel::TraceLoad::_option('dump_name', '$dump');" );
return "use $module";
},
stdout => [],
yaml => [ {
'rc' => '1',
'version' => undef,
'pkg' => 'main',
'file' => '-e',
'nested' => [],
'module' => $is_syn_package,
'line' => '1'
}
],
} );
my @test_keys = qw/stdout stderr yaml/;
my $tests = 0;
for my $test ( @schedule ) {
$tests += grep { exists $test->{$_} } @test_keys;
}
plan tests => $tests;
}
for my $test ( @schedule ) {
my $name = $test->{name};
my $dtl = '-MDevel::TraceLoad';
if ( my $opts = $test->{options} ) {
$dtl .= "=$opts";
}
my $script = $test->{setup}->();
my @cmd = ( $PERL, @INCLUDE, $dtl, ( HAS_F ? ( '-f' ) : () ), '-e',
$script );
my $cmd = join( ' ', @cmd );
#diag "Running $cmd\n";
if ( $^O =~ /Win32/ || $^O eq 'VMS' ) {
@cmd = join ' ', map { qq{"$_"} } @cmd;
}
open( my $ch, '-|', @cmd ) or die "Can't run $cmd";
chomp( my @stdout = <$ch> );
close $ch or die "Can't run $cmd";
if ( my $stdout = $test->{stdout} ) {
unless ( cmp_deeply( \@stdout, $stdout, "$name: capture matches" ) )
{
use Data::Dumper;
( my $var = $name ) =~ s/\s+/_/g;
diag( Data::Dumper->Dump( [ \@stdout ], [$var] ) );
}
}
if ( my $yaml = $test->{yaml} ) {
my $got = LoadFile( dump_file() );
unless ( cmp_deeply( $got, $yaml, "$name: YAML matches" ) ) {
use Data::Dumper;
( my $var = $name ) =~ s/\s+/_/g;
diag( Data::Dumper->Dump( [$got], [$var] ) );
}
}
}