# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
my $final = 0;
# Automatically generates an ok/nok msg, incrementing the test number.
BEGIN {
my($next, @msgs);
sub printok {
push @msgs, ($_[0] ? '' : 'not ') . "ok @{[++$next]}\n";
return !$_[0];
}
END {
print "\n1..", scalar @msgs, "\n", @msgs;
}
}
use Argv;
$final += printok(1);
# Make sure output arrives synchronously.
select(STDERR); $| = 1; select(STDOUT); $| = 1;
print "+ Testing basic construction and execution ...\n";
my $pl = Argv->new($^X, '-v');
$pl->stdout(0);
$pl->system;
$final += printok($? == 0);
print "+ Testing instance cloning ...\n";
$pl->clone->system;
$final += printok($? == 0);
print "+ Testing construction using references ...\n";
$final += printok(Argv->new($^X, [qw(-v)])->stdout(0)->system('') == 0);
print "+ Testing 'noexec' instance-method form ...\n";
$pl->noexec(1)->system;
$final += printok($? == 0);
print "+ Testing 'autofail' exception-handling ...\n";
$pl->argv($^X, ['-BADFLAG']);
$pl->autofail([\&printok, 1]);
$pl->stderr(0)->system;
print "+ Testing 'glob' method ...\n";
my $echo = Argv->new(qw(echo *));
$echo->glob;
print "'echo *' globs to: ";
$echo->system;
$final += printok($? == 0);
print "+ Testing 'dbglevel' instance-method form ...\n";
Argv->dbglevel(1);
my $ld = Argv->new($^X, qw(-bogus flag -V:ld));
$ld->dbglevel(0);
$ld->parse(qw(bogus=s));
$ld->system('-');
$final += printok($? == 0);
$ld->dbglevel(0);
$ld->dfltsets({'-' => 1});
print $ld->qx;
$final += printok($? == 0);
# Expected to return nonzero status and error (suppressed).
$final += printok(Argv->new('no-such-cmd')->stderr(0)->system);
my $e2 = Argv->new(qw(foo -y -x foo -r Next-to-last-test ...));
$e2->optset(qw(ONE TWO THREE));
$e2->parseONE(qw(x=s));
$e2->parseTWO(qw(y z));
$e2->parseTHREE('r');
$e2->prog('echo');
$e2->system;
$final += printok(!$? && ($e2->optsONE + $e2->optsTWO + $e2->optsTHREE) == 4);
exit $final if $final;
my $id2 = Argv->new(qw(id -y -x foo -a -r));
$id2->optset(qw(REMOVED));
my @removed = $id2->parseREMOVED(qw(r y x=s));
local $, = ' ';
print "Removed '@removed', left '@{[$id2->prog, $id2->opts, $id2->args]}'\n";
print "NOTE: this test sets the 'noexec' class attr so no exec will occur\n";
Argv->noexec(1);
$id2->exec(qw(-));