The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-
use strict;
use Benchmark;
use Test::More tests => 14;
select(STDERR); $| = 1; select(STDOUT); $| = 1;
use ClearCase::Argv qw(chdir);
use File::Temp qw(tempfile);
use File::Slurp;

ClearCase::Argv->summary;      # start keeping stats
ClearCase::Argv->ipc(1);
my $ct = ClearCase::Argv->new({autochomp=>1});
my @cmd = qw(des -s /@@ .); # -s in order to avoid timestamps
my ($outfh, $tmpout) = tempfile();
my ($errfh, $tmperr) = tempfile();
open(SAVEOUT, ">&STDOUT");
open(SAVEERR, ">&STDERR");
# Test 1
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
my $rc = $ct->argv(@cmd)->system;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
my @expout = read_file($tmpout);
my @experr = read_file($tmperr);
my $expoutok = @expout and $expout[0] =~ /^\.\@\@/;
my $experrok = @experr and $experr[0] =~ /^cleartool: Error: Unable to access/;
ok (($rc and $expoutok and $experrok), 'system: ret code, stdout and stderr.');
write_file($tmpout, ());
write_file($tmperr, ());
BAIL_OUT('The collection of the expected results failed')
  unless $rc and $expoutok and $experrok;
# Test 2
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
my @lastout = $ct->argv(@cmd)->qx;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
my @lasterr = read_file($tmperr);
ok (($rc and (@lastout eq @expout) and (@lasterr eq @experr) and !read_file($tmpout)),
    'qx: stdout ok, stderr ok.');
write_file($tmpout, ());
write_file($tmperr, ());
# Test 3
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
$rc = $ct->argv(@cmd)->stderr(0)->system;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@lastout = read_file($tmpout);
ok (($rc and (@lastout eq @expout) and !read_file($tmperr)),
    'system: stderr ignored, stdout ok.');
write_file($tmpout, ());
write_file($tmperr, ());
# Test 4
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
$rc = $ct->argv(@cmd)->stdout(0)->system;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@lasterr = read_file($tmperr);
ok (($rc and (@lasterr eq @experr) and !read_file($tmpout)),
    'system: stdout ignored, stderr ok.');
write_file($tmpout, ());
write_file($tmperr, ());
# Test 5
my $err = $ct->argv(@cmd)->stdout(0)->stderr(1)->qx;
ok ($err, 'qx: stdout ignored, stderr redirected to stdout ok.');
# Test 6
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
my $err = $ct->argv(@cmd)->stdout(0)->qx;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@lasterr = read_file($tmperr);
ok ((@lasterr eq @experr and !$err), 'qx: stdout ignored, stderr ok.');
# Test 7
@lastout = $ct->argv(@cmd)->stderr(0)->qx;
ok (@lastout eq @expout, 'qx: stderr ignored, stdout ok.');
eval { require ClearCase::CtCmd };
# Test 8 -- same thing for ctcmd mode, or what emulates it
$ct->ctcmd(2); #Gives a warning if CtCmd not installed
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
@lastout = $ct->argv(@cmd)->qx;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@lasterr = read_file($tmperr);
ok (($rc and (@lastout eq @expout) and (@lasterr eq @experr) and !read_file($tmpout)),
    'qx: stdout ok, stderr ok.');
write_file($tmpout, ());
write_file($tmperr, ());
# Test 9
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
$rc = $ct->argv(@cmd)->system;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@expout = read_file($tmpout);
@experr = read_file($tmperr);
ok (($rc and @expout and @experr), 'system: ret code, stdout and stderr.');
write_file($tmpout, ());
write_file($tmperr, ());
# Test 10
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
$rc = $ct->argv(@cmd)->stderr(0)->system;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@lastout = read_file($tmpout);
ok (($rc and (@lastout eq @expout) and !read_file($tmperr)),
    'system: stderr ignored, stdout ok.');
write_file($tmpout, ());
write_file($tmperr, ());
# Test 11
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
$rc = $ct->argv(@cmd)->stdout(0)->system;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@lasterr = read_file($tmperr);
ok (($rc and (@lasterr eq @experr) and !read_file($tmpout)),
    'system: stdout ignored, stderr ok.');
write_file($tmpout, ());
write_file($tmperr, ());
# Test 12
$err = $ct->argv(@cmd)->stdout(0)->stderr(1)->qx;
ok ($err, 'qx: stdout ignored, stderr redirected to stdout ok.');
# Test 13
open(STDOUT, ">$tmpout");
open(STDERR, ">$tmperr");
$err = $ct->argv(@cmd)->stdout(0)->qx;
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
@lasterr = read_file($tmperr);
ok ((@lasterr eq @experr and !$err), 'qx: stdout ignored, stderr ok.');
# Test 14
@lastout = $ct->argv(@cmd)->stderr(0)->qx;
ok (@lastout eq @expout, 'qx: stderr ignored, stdout ok.');

unlink $tmpout, $tmperr;
print STDERR "\n", ClearCase::Argv->summary;   # print out the stats we kept