#!perl

use strict;
use warnings;
use Test::More;
use IPC::Open3;
use File::Spec;
use Config;
use Devel::TraceUse ();
use lib ();

my $tlib  = File::Spec->catdir( 't', 'lib' );
my $tlib2 = File::Spec->catdir( 't', 'lib2' );
my $vlib  = defined $lib::VERSION ? " $lib::VERSION" : '';

# all command lines prefixed with $^X -I"t/lib"
my @tests = (
    [ << 'OUT', qw(-d:TraceUse -MParent -e1) ],
Modules used from -e:
   1.  Parent, -e line 0 [main]
   2.    Child, Parent.pm line 3
   3.      Sibling, Child.pm line 3
OUT
    [ << 'OUT', qw(-d:TraceUse -MChild -e1) ],
Modules used from -e:
   1.  Child, -e line 0 [main]
   2.    Sibling, Child.pm line 3
   3.      Parent, Sibling.pm line 4
OUT
    [ << 'OUT', qw(-d:TraceUse -MSibling -e1) ],
Modules used from -e:
   1.  Sibling, -e line 0 [main]
   2.    Child, Sibling.pm line 3
   3.      Parent, Child.pm line 4
OUT
    [ << 'OUT', qw(-d:TraceUse -MM1 -e1) ],
Modules used from -e:
   1.  M1, -e line 0 [main]
   2.    M2, M1.pm line 3
   3.      M3, M2.pm line 3
OUT
    [ << 'OUT', qw(-d:TraceUse -MM4 -e1) ],
Modules used from -e:
   1.  M4, -e line 0 [main]
   2.    M5, M4.pm line 3
   3.      M6, M5.pm line 9 [M5::in]
OUT
    [ << 'OUT', qw(-d:TraceUse -MM1 -e), 'require M4' ],
Modules used from -e:
   1.  M1, -e line 0 [main]
   2.    M2, M1.pm line 3
   3.      M3, M2.pm line 3
   4.  M4, -e line 1 [main]
   5.    M5, M4.pm line 3
   6.      M6, M5.pm line 9 [M5::in]
OUT
    [ << 'OUT', qw(-d:TraceUse -e), 'require M4; use M1' ],
Modules used from -e:
   1.  M1, -e line 1 [main]
   2.    M2, M1.pm line 3
   3.      M3, M2.pm line 3
   4.  M4, -e line 1 [main]
   5.    M5, M4.pm line 3
   6.      M6, M5.pm line 9 [M5::in]
OUT
    [ << 'OUT', qw(-d:TraceUse -MM4 -MM1 -e M5->load) ],
Modules used from -e:
   1.  M4, -e line 0 [main]
   2.    M5, M4.pm line 3
   3.      M6, M5.pm line 9 [M5::in]
   7.      M7 0, M5.pm line 4
   4.  M1, -e line 0 [main]
   5.    M2, M1.pm line 3
   6.      M3, M2.pm line 3
OUT
    [ << 'OUT', qw(-d:TraceUse -e), 'eval { use M1 }' ],
Modules used from -e:
   1.  M1, -e line 1 [main]
   2.    M2, M1.pm line 3
   3.      M3, M2.pm line 3
OUT
    [ << "OUT", '-d:TraceUse', "-Mlib=$tlib2", '-MM8', '-e1' ],
Modules used from -e:
   0.  lib$vlib, -e line 0 [main]
Modules used, but not reported:
  M8.pm
OUT
    [ << "OUT", '-d:TraceUse', "-Mlib=$tlib2", '-MM1', '-MM8', '-e1' ],
Modules used from -e:
   0.  lib$vlib, -e line 0 [main]
   0.  M1, -e line 0 [main]
   0.    M2, M1.pm line 3
   0.      M3, M2.pm line 3
   0.  M8, -e line 0 [main]
OUT
    [ << "OUT", '-d:TraceUse', "-Mlib=$tlib2", '-MM7', '-MM8', '-e1' ],
Modules used from -e:
   0.  lib$vlib, -e line 0 [main]
   0.  M7 0, -e line 0 [main]
   0.  M8, -e line 0 [main]
OUT
    [ << 'OUT', qw(-d:TraceUse -e), 'eval { require M10 }' ],
Modules used from -e:
   1.  M10, -e line 1 [main] (FAILED)
OUT
    [   << 'OUT', qw(-d:TraceUse -e), "eval { require M10 };\npackage M11;\neval { require M10 }" ],
Modules used from -e:
   1.  M10, -e line 1 [main] (FAILED)
   2.  M10, -e line 3 [M11] (FAILED)
OUT
    [   << "OUT", '-d:TraceUse', '-MM7', "-Mlib=$tlib2", '-MM1', '-MM8', '-e1' ],
Modules used from -e:
   0.  M7 0, -e line 0 [main]
   0.  lib$vlib, -e line 0 [main]
   0.  M1, -e line 0 [main]
   0.    M2, M1.pm line 3
   0.      M3, M2.pm line 3
   0.  M8, -e line 0 [main]
OUT
    [   << 'OUT', '-d:TraceUse', "-I$tlib2", qw( -MM4 -MM1 -MM8 -MM10 -e M5->load) ],
Modules used from -e:
   1.  M4, -e line 0 [main]
   2.    M5, M4.pm line 3
   3.      M6, M5.pm line 9 [M5::in]
  11.      M7 0, M5.pm line 4
   4.  M1, -e line 0 [main]
   5.    M2, M1.pm line 3
   6.      M3, M2.pm line 3
   7.  M8, -e line 0 [main]
   8.  M10, -e line 0 [main]
   9.    M11 1.01, M10.pm line 3 [M8]
  10.    M12 1.12, M10.pm line 4 [M8]
OUT
);

# Module::CoreList-related tests
if ( eval { require Module::CoreList; 1; } ) {
    diag "Module::CoreList $Module::CoreList::VERSION installed";

    # Module::CoreList always knew about those
    push @tests,
        [ << 'OUT', '-d:TraceUse=hidecore:5.5.30', '-MConfig', '-e1' ],
Modules used from -e:
OUT
        [ << 'OUT', '-d:TraceUse=hidecore:5.006001', '-MConfig', '-e1' ],
Modules used from -e:
OUT
        if $] < 5.013010;
    push @tests, [ [
        "Module::CoreList $Module::CoreList::VERSION doesn't know about Perl 4"
    ], << "OUT", '-d:TraceUse=hidecore:4', '-e1' ];
Modules used from -e:
OUT

    # does Module::CoreList know about this Perl?
    my $this_perl = Devel::TraceUse::numify($]);
    my @warns
        = exists $Module::CoreList::version{$this_perl}
        ? ()
        : ([ "Module::CoreList $Module::CoreList::VERSION doesn't know about Perl $this_perl" ]);
    push @tests, [ @warns,
       << "OUT", '-d:TraceUse=hidecore', '-Mstrict', '-e1' ];
Modules used from -e:
OUT

    # convert Module::CoreList devel version numbers to a number
    my $corelist_version = '2.49_01';#$Module::CoreList::VERSION;
    $corelist_version =~ tr/_//d;

    # Module::CoreList didn't know about 5.001 until its version 2.00
    push @tests, [ << 'OUT', '-d:TraceUse=hidecore:5.1', '-MConfig', '-e1' ],
Modules used from -e:
   1.  Config, -e line 0 [main]
OUT
        if $corelist_version >= 2 && $] < 5.013010;
}
else {
    diag "Module::CoreList not installed";
    push @tests, [ [
        q"Can't locate Module/CoreList.pm in @INC (@INC contains: <DELETED>)",
         'END failed--call queue aborted.'
    ], '', '-d:TraceUse=hidecore', '-e1' ];
}

my $warn_d = 'Use -d:TraceUse for more accurate information.';

# -MDevel::TraceUse usually produces the same output as -d:TraceUse
for ( 0 .. $#tests ) {
    unshift @{ $tests[$_] }, [] unless ref $tests[$_][0];
    push( @tests, [ @{ $tests[$_] } ] );
    $tests[-1][0] = [ @{ $tests[$_][0] } ];
    # keep options the same
    $tests[-1][2] =~ s/^-d:TraceUse/-MDevel::TraceUse/;
    # also expect the note about -d:TraceUse
    unshift @{ $tests[-1][0] }, $warn_d;
}

# but there are some exceptions
push @tests, (
    [ [], << 'OUT', qw(-d:TraceUse -e), 'eval q(use M1)' ],
Modules used from -e:
   1.  M1, -e line 1 (eval 1) [main]
   2.    M2, M1.pm line 3
   3.      M3, M2.pm line 3
OUT
    [ [$warn_d], << 'OUT', qw(-MDevel::TraceUse -e), 'eval q(use M1)' ],
Modules used from -e:
   1.  M1, (eval 1) [main]
   2.    M2, M1.pm line 3
   3.      M3, M2.pm line 3
OUT
    [ [], << 'OUT', qw(-d:TraceUse -MM9 -e1) ],
Modules used from -e:
   1.  M9, -e line 0 [main]
   2.    M6, M9.pm line 3 (eval 1)
OUT
    [ [$warn_d], << 'OUT', qw(-MDevel::TraceUse -MM9 -e1) ],
Modules used from -e:
   1.  M9, -e line 0 [main]
   2.  M6, (eval 1) [M9]
OUT
);

my @outputs = (
    undef,
    'out.txt',
    File::Spec->rel2abs('out.txt'),
);

plan tests => (scalar(@outputs) * scalar(@tests));

my @temp_files;

# Clean-up
END {
    unlink for grep { -f $_ } @temp_files;
}

foreach my $o (@outputs) {
    run_test($o, @$_) for @tests;
}

sub run_test {
    my ( $output_file, $warns, $errput, @cmd ) = @_;

    if ( defined $output_file ) {
        #diag $output_file";
        @cmd = map {
            s/^(-.*?:TraceUse=..*)$/$1,output:$output_file/;
            s/^(-.*?:TraceUse)=?$/$1=output:$output_file/;
            $_
        } @cmd;
        push @temp_files, $output_file;
    }

    # Test name
    ( my $mesg = "Trace for: perl @cmd" ) =~ s/\n/\\n/g;

    # run the test subcommand
    local ( *IN, *OUT, *ERR );
    my $pid = open3( \*IN, \*OUT, \*ERR, $^X, '-Iblib/lib', "-I$tlib", @cmd );
    my @errput = map { s/[\015\012]*$//; $_ } <ERR>;
    waitpid( $pid, 0 );

    my @out;
    if (defined $output_file && length $errput) {
        unless (-f $output_file) {
            fail $mesg;
            diag qq(Missing expected output file "$output_file");
            return;
        }
        open my $f, '<', $output_file;
        @out = map { s/[\015\012]*$//; $_ } <$f>;
        close $f;
        unlink $f;
    }

    # we want to ignore modules loaded by those libraries
    my $nums = 1;
    for my $lib (qw( lib sitecustomize.pl )) {
        for my $arr (\@errput, \@out) {
            if ( grep /\. +.*\Q$lib\E[^,]*,/, @$arr ) {
                @$arr = normalize( $lib, @$arr );
                $nums = 0;
            }
        }
    }

    # take sitecustomize.pl into account in our expected errput
    ( $nums, $errput ) = add_sitecustomize( $nums, $errput, @cmd )
        if $Config{usesitecustomize};

    # clean up the "Can't locate" error message
    s/\(\@INC contains: .*/(\@INC contains: <DELETED>)/ for @errput;

    push @errput, @out;

    # remove version number of core modules used in testing
    s/(strict )[^,]+,/$1%%%,/g for @errput;

    # compare the results
    my @expected = map { s/[\015\012]*$//; $_ } split /^/, $errput;
    @expected = map { s/^(\s*\d+)\./%%%%./; $_ } @expected if !$nums;
    unshift @expected, @$warns;

    is_deeply( \@errput, \@expected, $mesg )
        or diag map ( {"$_\n"} '--- Got ---', @errput ),
        "--- Expected ---\n$errput";
}

# removes unexpected modules loaded by somewhat expected ones
# and normalize the errput so we can ignore them
sub normalize {
    my ( $lib, @lines ) = @_;
    my $loaded_by = 0;
    my $tab;
    for (@lines) {
        s/^(\s*\d+)\./%%%%./;
        if (/\.( +)\Q$lib\E[^,]*,/) {
            $loaded_by = 1;
            $tab       = $1 . '  ';
            next;
        }
        if ($loaded_by) {
            if   (/^%%%%\.$tab/) { $_         = 'deleted' }
            else                 { $loaded_by = 0 }
        }
    }
    return grep { $_ ne 'deleted' } @lines;
}

my $diag;

sub add_sitecustomize {
    my ( $nums, $errput, @cmd ) = @_;
    my $sitecustomize_path
        = File::Spec->catfile( $Config{sitelib}, 'sitecustomize.pl' );
    my ($sitecustomize) = grep { /sitecustomize\.pl$/ } keys %INC;

    # provide some info to the tester
    if ( !$diag++ ) {
        diag "This perl has sitecustomize.pl enabled, ",
            -e $sitecustomize_path
            ? "and the file $sitecustomize_path exists"
            : "but the file $sitecustomize_path does not exist";
        diag "$sitecustomize was loaded successfully"
            if $sitecustomize;
    }

    # the output depends on the existence of sitecustomize.pl
    if ( -e $sitecustomize_path ) {

        # Loaded so first it's not caught by our @INC hook:
        #  Modules used, but not reported:
        #    /home/book/local/5.8.9/site/lib/sitecustomize.pl
        $errput =~ s/Modules used, but not reported:.*?^(.*)//gsm;
        my @not_reported = ( "  $sitecustomize\n", $1 ? split /^/, $1 : () );
        $errput .= "Modules used, but not reported:\n" . join '',
            sort @not_reported;
    }
    elsif ( grep { $_ eq '-d:TraceUse' } @cmd ) {

        # Loaded first, but FAIL. The debugger will tell us with an older Perl.
        #  Modules used from -e:
        #     1.  C:/perl/site/lib/sitecustomize.pl, -e line 0 [main] (FAILED)
        if ( $] < 5.011 ) {
            $errput =~ s{Modules used from.*?^}
                        {$&   0.  $sitecustomize, -e line 0 [main] (FAILED)\n}sm;
            $nums = 0;
        }
    }

    # updated values
    return ( $nums, $errput );
}