#!/usr/bin/perl -w
# -*- perl -*-

#
# Author: Slaven Rezic
#

use strict;
use FindBin;
use File::Temp qw(tempfile);

BEGIN {
    if (!eval q{
	use Test::More;
	1;
    }) {
	print "1..0 # skip no Test::More module\n";
	exit;
    }

    *eq_or_diff = eval { require Test::Differences; \&Test::Differences::eq_or_diff } || \&Test::More::is;
}

my $psort = "$FindBin::RealBin/../blib/script/psort";

# Special handling for systems without shebang handling
my $full_script = $^O eq 'MSWin32' ? qq{"$^X" $psort} : $psort;

my @test_defs =
    (# options
     #       in
     #              out (expected)
     #                     --check(able)
     #                        in is unsorted
     [undef, <<EOF, <<EOF, 1, 1],
c
b
a
EOF
a
b
c
EOF

    [undef, <<EOF, <<EOF, 1, 1],
abc

xyz
EOF

abc
xyz
EOF

    [undef, <<EOF, <<EOF, 1, 1],
\tTAB

EOF

\tTAB
EOF

     [undef, "", "", 1, 0],

     [undef, "\n", "\n", 1, 0],

     [undef, "one line", "one line", 1, 0],

     [undef, "one line\n", "one line\n", 1, 0],

     [["-r"], <<EOF, <<EOF, 1, 0],
c
b
a
EOF
c
b
a
EOF

     [["-f"], <<EOF, <<EOF, 1, 1],
C
b
A
EOF
A
b
C
EOF

     [["-bf"], <<EOF, <<EOF, 1, 1],
 C
  b
A
EOF
A
  b
 C
EOF

     [["-n"], <<EOF, <<EOF, 1, 1],
111
22
3
EOF
3
22
111
EOF

     [["-n", "-r"], <<EOF, <<EOF, 1, 0],
111
22
3
EOF
111
22
3
EOF

     [['-N', '-f'], <<EOF, <<EOF, 1, 1],
foo12a
foo12z
foo13a
foo
14
9x
foo12
fooa
foolio
Foolio
Foo12a
EOF
9x
14
foo
fooa
foolio
Foolio
foo12
foo12a
Foo12a
foo12z
foo13a
EOF

     # same like -N -f, but manually use'ing the module and defining
     # the compare function
     [['-MSort::Naturally=ncmp', '-C', 'ncmp($a, $b)', '-f'], <<EOF, <<EOF, 1, 1],
foo12a
foo12z
foo13a
foo
14
9x
foo12
fooa
foolio
Foolio
Foo12a
EOF
9x
14
foo
fooa
foolio
Foolio
foo12
foo12a
Foo12a
foo12z
foo13a
EOF

     # BEGIN blocks work, too
     [['-C', 'BEGIN { use Sort::Naturally qw(ncmp) } ncmp($a, $b)', '-f'], <<EOF, <<EOF, 1, 1],
foo12a
foo12z
foo13a
foo
14
9x
foo12
fooa
foolio
Foolio
Foo12a
EOF
9x
14
foo
fooa
foolio
Foolio
foo12
foo12a
Foo12a
foo12z
foo13a
EOF

     # -M without import list
     [['-MSort::Naturally', '-C', 'ncmp($a, $b)', '-f'], <<EOF, <<EOF, 1, 1],
foo12a
foo12z
foo13a
foo
14
9x
foo12
fooa
foolio
Foolio
Foo12a
EOF
9x
14
foo
fooa
foolio
Foolio
foo12
foo12a
Foo12a
foo12z
foo13a
EOF

     [['-N', '-r'], <<EOF, <<EOF, 1, 1],
foo12a
foo12z
foo13a
foo
14
9x
foo12
fooa
foolio
EOF
foo13a
foo12z
foo12a
foo12
foolio
fooa
foo
14
9x
EOF

     [["-V"], <<EOF, <<EOF, 1, 1],
1.0
2.3.0
1.1.5.1
2.3.1
20
10.0
EOF
1.0
1.1.5.1
2.3.0
2.3.1
10.0
20
EOF

     [["-Vr"], <<EOF, <<EOF, 1, 1],
1.0
2.3.0
1.1.5.1
2.3.1
20
10.0
EOF
20
10.0
2.3.1
2.3.0
1.1.5.1
1.0
EOF

     [["-e", 'm{(\d+) wallclock secs}; $1'], <<EOF, <<EOF, 1, 1],
Files=1, Tests=3,  3 wallclock secs ( 0.02 usr  0.02 sys +  0.09 cusr  0.01 csys =  0.14 CPU)
Files=1, Tests=3,  0 wallclock secs ( 0.02 usr  0.02 sys +  0.09 cusr  0.01 csys =  0.14 CPU)
Files=1, Tests=3,  2 wallclock secs ( 0.02 usr  0.02 sys +  0.09 cusr  0.01 csys =  0.14 CPU)
EOF
Files=1, Tests=3,  0 wallclock secs ( 0.02 usr  0.02 sys +  0.09 cusr  0.01 csys =  0.14 CPU)
Files=1, Tests=3,  2 wallclock secs ( 0.02 usr  0.02 sys +  0.09 cusr  0.01 csys =  0.14 CPU)
Files=1, Tests=3,  3 wallclock secs ( 0.02 usr  0.02 sys +  0.09 cusr  0.01 csys =  0.14 CPU)
EOF

     [["-C", '$a cmp $b'], <<EOF, <<EOF, 1, 1],
c
b
a
EOF
a
b
c
EOF

     [["-v"], "", qr{^psort version \d+\.\d+(?:_\d+)?$}, 0, undef],

    );

my @erroneous_test_defs =
    (
     [["--invalid-option"], "", qr{usage}],
     [["--field-function", 'perl compile er{ror'], '', qr{Cannot compile}],
     [["--compare-function", 'perl compile er{ror'], '', qr{Cannot compile}],
     [['-MThis::Module::Does::Not::Exist'], '', qr{Can't locate}],
     [['-MSort::Naturally=', '-C', 'ncmp($a,$b)'], "first test line\nsecond test line\n", qr{Undefined subroutine}],
    );

my $ok_test_count    = 4;
my $error_test_count = 2;
plan tests => 1 + $ok_test_count*@test_defs + $error_test_count*@erroneous_test_defs;

SKIP: {
    skip "-x test does not work on Windows", 1
	if $^O eq 'MSWin32';

    ok -x $psort, 'psort is executable';
}

for my $test_def (@test_defs) {
    run_psort_testcase(@$test_def);
}

for my $test_def (@erroneous_test_defs) {
    run_psort_erroneous_testcase(@$test_def);
}

sub _run_psort_testcase {
    my($expect_error, $args, $indata, $expected, $checkable, $unsorted_in) = @_;
    $args = [] if !$args;

    my($tmpfh,$tmpfile) = tempfile(UNLINK => 1, SUFFIX => ".dat")
	or die $!;
    print $tmpfh $indata;
    close $tmpfh
	or die $!;

    my @sort_cmd  = ($full_script, @$args, $tmpfile);

 SKIP: {
	my $run_res = _run_psort(\@sort_cmd, $expect_error, undef);
	if ($run_res->{error}) {
	    skip $run_res->{error}, $expect_error ? $error_test_count : $ok_test_count;
	}
	
	my $cmd_res = $run_res->{cmdres};
	my $buf     = $expect_error ? $run_res->{stderr} : $run_res->{stdout};

	if ($expect_error) {
	    ok !$cmd_res, 'Expected failure'
		or diag "While running '@sort_cmd'";
	} else {
	    ok $cmd_res, 'Expected success'
		or diag "While running '@sort_cmd': $?";
	}

	my $testlabel = !defined $args ? '<no args>' : "args: <@$args>";
	if (ref $expected eq 'Regexp') {
	    like $buf, $expected, $testlabel;
	} else {
	    eq_or_diff $buf, $expected, $testlabel;
	}

	if (!$expect_error) {
	SKIP: {
		skip "This test case is not checkable", 2
		    if !$checkable;

		# Check input data
		{
		    my @check_args = (@$args, (rand(2) < 1 ? '--check' : '-c'));
		    my @check_cmd = ($full_script, @check_args, $tmpfile);
		    system @check_cmd;
		    my $ret = $?>>8;
		    is $ret, $unsorted_in, "Check command with args <@check_args> returned $ret (in data)";
		}

		# Check sorted data
		{
		    my($tmpsortfh,$tmpsortfile) = tempfile(UNLINK => 1, SUFFIX => '.dat')
			or die $!;
		    print $tmpsortfh $buf;
		    close $tmpsortfh
			or die $!;

		    my @check_args = (@$args, (rand(2) < 1 ? '--check' : '-c'));
		    my @check_cmd = ($full_script, @check_args, $tmpsortfile);
		    system @check_cmd;
		    is $?, 0, "Check command with args <@check_args> returned $? (sorted data)";

		    unlink $tmpsortfile;
		}
	    }
	}
    }

    unlink $tmpfile;
}

sub run_psort_testcase {
    my($args, $indata, $expected, $checkable, $unsorted_in) = @_;
    _run_psort_testcase(0, $args, $indata, $expected, $checkable, $unsorted_in);
}

sub run_psort_erroneous_testcase {
    my($args, $indata, $expected) = @_;
    _run_psort_testcase(1, $args, $indata, $expected);
}

sub _run_psort {
    my($sort_cmd, $get_stderr, $input_ref) = @_;

    my $stdout = '';
    my $stderr = '';
    my $cmdres;

    if (eval { require IPC::Run; 1 }) {
	$cmdres = IPC::Run::run($sort_cmd, ">", \$stdout, "2>", \$stderr, ($input_ref ? ("<", $input_ref) : ()));
    } else {
	if ($get_stderr) {
	    return { error => "Can't run stderr tests without IPC::Run" };
	} elsif ($input_ref) {
	    return { error => "Can't run stdin tests without IPC::Run" };
	} elsif ($^O eq 'MSWin32') {
	    return { error => "MSWin32 needs IPC::Run for tests because: List form of pipe open not implemented" };
	} else {
	    my $fh;
	    if ($] < 5.008) {
		open $fh, "-|" or exec @$sort_cmd;
	    } else {
		open $fh, "-|", @$sort_cmd
		    or die "While running @$sort_cmd: $!";
	    }
	    while(<$fh>) {
		$stdout .= $_;
	    }
	    $cmdres = close $fh;
	}
    }
    return {
	    cmdres => $cmdres,
	    stdout => $stdout,
	    stderr => $stderr,
	   };
}

__END__
