1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
# 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 Config;
use Test;
my $iswin32;
BEGIN {
$| = 1;
if ($] < 5.003) {
eval("require Win32");
$iswin32 = ! $@;
} else {
$iswin32 = $^O eq "MSWin32";
}
plan tests => 7, 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.
my($test, $ret, $wdir);
$test = Test::Cmd->new(workdir => '');
$perl = $^X;
@path_dirs = split(/$Config{path_sep}/, $ENV{PATH});
while (! -x $perl) {
$dir = shift @path_dirs;
if (! $dir) {
print "# Can not find executable $^X on PATH\n";
print "# ($ENV{PATH}\n";
exit (1);
}
$perl = Test::Cmd->catfile($dir, $^X);
}
if (! Test::Cmd->file_name_is_absolute($perl)) {
use Cwd;
$perl = Test::Cmd->catfile(Cwd::cwd(), $perl);
}
$flags = "-I " . join(" -I ", @INC);
$ret = $test->run(prog => "$perl $flags", stdin => <<'EOF');
use Test::Cmd::Common;
$t = Test::Cmd::Common->new(workdir => '');
$t->write('file', "the\nfile\n");
$t->unlink('file');
$t->pass;
EOF
ok($ret == 0);
ok($test->stdout eq "");
ok($test->stderr =~ /PASSED/ms);
$ret = $test->run(prog => "$perl $flags", stdin => <<'EOF');
use Test::Cmd::Common;
$t = Test::Cmd::Common->new(workdir => '');
$t->unlink('file', ['foo', 'file']);
$t->pass;
EOF
ok(($ret >> 8) == 2);
ok($test->stdout eq "");
ok($test->stderr =~ /could not unlink files.*NO RESULT/ms);
|
