# Copyright 1999-2001 Steven Knight.  All rights reserved.  This program
# is free software; you can redistribute it and/or modify it under the
# same terms as Perl itself.

######################### We start with some black magic to print on failure.

use Test;
BEGIN { $| = 1; plan tests => 19, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } }
END {print "not ok 1\n" unless $loaded;}
use Test::Cmd;
$loaded = 1;
ok(1);

######################### End of black magic.

$here = Test::Cmd->here();
my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" :
			"-I".Test::Cmd->catfile($here, $_), @INC);

my($run_env, $wdir, $ret, $test, $wd, $string);

$run_env = Test::Cmd->new(workdir => '');
ok($run_env);
$wdir = $run_env->workdir;
ok($wdir);
$ret = chdir($wdir);
ok($ret);

# Everything before this was merely preparation of our "source directory."

my @cleanup;

END {
    foreach my $dir (@cleanup) {
	rmdir $dir if -d $dir;
    }
}

sub contents {
    my $file = shift;
    if (! open(FILE, $file)) {
	return undef;
    }
    my $string = join('', <FILE>);
    if (! close(FILE)) {
	return undef;
    }
    return $string;
}

sub test_it {
    my($condition, $preserved) = @_;

    my %close_true = (
	'pass'		=> 1,
	'fail'		=> 0,
	'no_result'	=> 0,
    );

    my %exit_status = (
	'pass'		=> 0,
	'fail'		=> 1,
	'no_result'	=> 2,
    );

    my %result_string = (
	'pass'		=> "PASSED\n",
	'fail'		=> "FAILED test at line 5 of -.\n",
	'no_result'	=> "NO RESULT for test at line 5 of -.\n",
    );

    if (! open(PERL, "|$^X @I_FLAGS >perl.stdout 2>perl.stderr")) {
	print STDOUT "# Could not open $^X: $!\n";
	return undef;
    }


    my $ret = print PERL <<EOF;
use Test::Cmd;
\$test = Test::Cmd->new(workdir => '');
Test::Cmd->fail(! \$test);
print STDOUT \$test->workdir;
\$test->$condition;
EOF
    if (! $ret) {
	print STDOUT "# Could not write to $^X: $!\n";
	return undef;
    }

    $ret = close(PERL);
    if ($close_true{$condition} ? ! $ret : $ret) {
	print STDOUT "# Unexpected return from close(): $!\n";
	$wd = contents("perl.stdout");
	push @cleanup, $wd if defined $wd;
	return undef;
    }

    if (($?>>8) != $exit_status{$condition}) {
	print STDOUT "# Expected exit status ", $exit_status{$condition}, " got ", $?>>8, "\n";
	$wd = contents("perl.stdout");
	push @cleanup, $wd if defined $wd;
	return undef;
    }

    $wd = contents("perl.stdout");
    if (! defined $wd) {
	print STDOUT "# no working directory path name on standard output\n";
	return undef;
    }
    push @cleanup, $wd;

    $string = contents("perl.stderr");
    if ($string ne $result_string{$condition}) {
	print STDOUT "# Expected error output:\n";
	print STDOUT "# ", $result_string{$condition};
	print STDOUT "# Got error output:\n";
	print STDOUT "# ", $string;
	return undef;
    }

    return ($preserved ? -d $wd : ! -d $wd);
}

delete $ENV{PRESERVE};
delete $ENV{PRESERVE_PASS};
delete $ENV{PRESERVE_FAIL};
delete $ENV{PRESERVE_NO_RESULT};

$ret = test_it('pass', 0);
ok($ret);
$ret = test_it('fail', 0);
ok($ret);
$ret = test_it('no_result', 0);
ok($ret);

$ENV{PRESERVE} = '1';
delete $ENV{PRESERVE_PASS};
delete $ENV{PRESERVE_FAIL};
delete $ENV{PRESERVE_NO_RESULT};

$ret = test_it('pass', 1);
ok($ret);
$ret = test_it('fail', 1);
ok($ret);
$ret = test_it('no_result', 1);
ok($ret);

delete $ENV{PRESERVE};
$ENV{PRESERVE_PASS} = '1';
delete $ENV{PRESERVE_FAIL};
delete $ENV{PRESERVE_NO_RESULT};

$ret = test_it('pass', 1);
ok($ret);
$ret = test_it('fail', 0);
ok($ret);
$ret = test_it('no_result', 0);
ok($ret);

delete $ENV{PRESERVE};
delete $ENV{PRESERVE_PASS};
$ENV{PRESERVE_FAIL} = '1';
delete $ENV{PRESERVE_NO_RESULT};

$ret = test_it('pass', 0);
ok($ret);
$ret = test_it('fail', 1);
ok($ret);
$ret = test_it('no_result', 0);
ok($ret);

delete $ENV{PRESERVE};
delete $ENV{PRESERVE_PASS};
delete $ENV{PRESERVE_FAIL};
$ENV{PRESERVE_NO_RESULT} = '1';

$ret = test_it('pass', 0);
ok($ret);
$ret = test_it('fail', 0);
ok($ret);
$ret = test_it('no_result', 1);
ok($ret);