The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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] ) );
    }
  }
}