#!perl

# THIS IS A WORK IN PROGRESS
# IT SHOULD BE CONSIDERED ALPHA
# BUT I EXPECT IT TO IMPROVE
# THIS IS A RE-IMPLEMENTATION OF PREVIOUS CODE THAT WAS WRITTEN
# ON-THE-FLY AS NEEDED. 

# YOU ARE ADVISED TO RUN THE TEST SCRIPT!!!

use strict;
use warnings;

use Test::More;
use Data::Dumper;

use feature qw(state say);

BEGIN {
    print "\n\nTESTS BEGIN \n\n\n";
    use_ok ( 'Minimal' ); # Can I even use a module in this directory?
    use_ok ( 'File::Copy' );
    use_ok ( 'Carp' );
    use_ok ( 'Debug::Xray' ) or die 'Can\'t use Debug::Xray';
    use_ok ( 'IO::CaptureOutput', qw(capture capture_exec) );
    #use_ok ( 'Debug::Xray::Tie' ) or die 'Can\t use Debug::Xray::Tie';
};


{
    can_ok ('Debug::Xray', 'start_sub' );
    can_ok ('main', 'start_sub' );
    can_ok ('Debug::Xray', 'set_debug_verbose' );
    can_ok ('main', 'set_debug_verbose' );
}


{
    is ( Debug::Xray::is_verbose(), 1, 'Debug::Xray is verbose' ) or die 'Debug::Xray must be verbose';
    is ( dprint('this is a test'), 'this is a test', 'Debug::Xray::dprint ok' );
}


{

    {
    my $expected_sub_1_output = <<END_SUB_1;
SUB: main::sub_1
    this is sub 1
    SUB: main::sub_2
        this is sub 2
        SUB: main::sub_3
            this is sub 3
        END: main::sub_3
    END: main::sub_2
END: main::sub_1
END_SUB_1

        {
            my ($stdout, $stderr);
            capture sub {sub_1()}, \$stdout, \$stderr;
            is ($stdout, $expected_sub_1_output, 'start_sub, dprint, end_sub ok' );
        }


        {
            my $expected_sub_10_output = $expected_sub_1_output;
            
            $expected_sub_10_output =~ s/$/0/gm;
            $expected_sub_10_output =~ s/^0$//gm; # fix last line

            my ($stdout, $stderr);
            my $hook = hook_subs( 'main::sub_10', 'main::sub_20', 'main::sub_30' );
            capture sub {sub_10()}, \$stdout, \$stderr;

            is ($stdout, $expected_sub_10_output, 'start_sub, dprint, end_sub ok' );
        }
    }
}



{
    my $expected_sub_10_output = <<END_SUB_10;
SUB: main::sub_10
    this is sub 10
    SUB: main::sub_20
        this is sub 20
        SUB: main::sub_30
            this is sub 30
            SUB: main::sub_40
            END: main::sub_40
        END: main::sub_30
    END: main::sub_20
END: main::sub_10
END_SUB_10

    {
        my ($stdout, $stderr);
        my $hook = hook_all_subs();
        capture sub {sub_10()}, \$stdout, \$stderr;

        is ($stdout, $expected_sub_10_output, 'start_sub, dprint, end_sub ok' );
    }
}


# Make sure that when lexical hooks are out of scope, they are no longer in effect
{
    {
        my ($stdout, $stderr);
        capture sub {sub_10()}, \$stdout, \$stderr;
        is ($stdout, "this is sub 10\nthis is sub 20\nthis is sub 30\n", 'Lexical hooks are gone' );
    }
}


# Test tie
{
    # TODO Check how tie events get logged
    my $var;

    my ($stdout, $stderr);

    capture sub { tie $var, 'Debug::Xray::Tie' }, \$stdout, \$stderr; 
    is ( $stdout, 'TIESCALAR undef', 'TIESCALAR ran' );
    isnt ( $stdout, 'TIESCALAR undef', 'TIESCALAR ran, but I don\t like the undef' );

    capture sub { $var = 1 }, \$stdout, \$stderr;
    is ( $var, 1, '$var ok after tie and assignment' );
    is ( $stdout, 'STORE 1 to var', 'Store 1 to var ok' );
  
    capture sub { $var = 2 }, \$stdout, \$stderr;
    is ( $var, 2, '$var ok after re-assignment' );
    is ( $stdout, 'STORE 1 to var', 'Store 2 to var ok' );
}


{
    # TODO Check how tie events get logged
    my ($stdout, $stderr);
    my $var;

    capture sub { add_watch_var($var, 'var') }, \$stdout, \$stderr;
    is ( $stdout, 'TIESCALAR undef', 'TIESCALAR ran - what should the value be?' );

    capture sub { $var = 1 }, \$stdout, \$stderr;
    is ( $var, 1, 'Stored 1' );
    is ( $stdout, 'STORE 1 to var', 'STORE 1 to var' );

    capture sub { $var = 2 }, \$stdout, \$stderr;
    is ( $var, 2, 'Stored 2' );
    is ( $stdout, 'STORE 1 to var', 'STORE 1 to var' ); 

    my $var2 = 3;

    capture sub { add_watch_var($var2, 'var2') }, \$stdout, \$stderr;
    is ( $var2, 3, 'Watch $var2' );
    is ( $stdout, 'TIESCALAR undef', 'TIESCALAR ran - what should the value be?' );

    capture sub { $var2 = 4 }, \$stdout, \$stderr;
    is ( $var2, 4, 'Stored 4 in $var2' );
    is ( $stdout, 'STORE 4 to var2', 'STORE 4 to var2' );

    is ( $var, 2, '$var is undisturbed' );

    capture sub { $var = 5 }, \$stdout, \$stderr;
    is ( $var, 5, 'Stored 5 in $var' );
    is ( $stdout, 'STORE 5 to var', 'STORE 5 to var' );

    capture sub { $var = 6 }, \$stdout, \$stderr;
    is ( $var, 6, 'Stored 6 in $var' );
    is ( $var2, 4, '$var2 is undisturbed' );
    is ( $stdout, 'STORE 6 to var', 'STORE 6 to var' );

    capture sub { $var = $var2 }, \$stdout, \$stderr;
    is ( $var, 4, '$var is undisturbed after Store' );
    is ( $var2, 4, '$var2 is undisturbed after Fetch' );
    is ( $stdout, 'STORE 2 to var', 'STORE 2 to var' );
}


# Test error handling
{
    sub divide_by_zero {
        my $result = 100/0;
    }

    my $hook = hook_subs( 'main::divide_by_zero' );
    
    divide_by_zero();
}

done_testing();


sub sub_1 {
    start_sub();
    dprint ('this is sub 1');
    sub_2();
    end_sub();
}

sub sub_2 {
    start_sub();
    dprint ('this is sub 2');
    sub_3();
    end_sub();
}

sub sub_3 {
    start_sub();
    dprint ('this is sub 3');
    end_sub();
}

sub sub_4 {
    start_sub();
    dprint ('this is sub 4');
    end_sub();
}

sub sub_10 {
    dprint ('this is sub 10');
    sub_20();
}

sub sub_20 {
    dprint ('this is sub 20');
    sub_30();
}

sub sub_30 {
    dprint ('this is sub 30');
    sub_40();
}

sub sub_40 {
}