1 | #!./perl
|
---|
2 |
|
---|
3 | BEGIN {
|
---|
4 | chdir 't' if -d 't';
|
---|
5 | @INC = '../lib';
|
---|
6 | }
|
---|
7 |
|
---|
8 | use Test::More tests => 7;
|
---|
9 |
|
---|
10 | BEGIN { use_ok('Shell'); }
|
---|
11 |
|
---|
12 | my $so = Shell->new;
|
---|
13 | ok($so, 'Shell->new');
|
---|
14 |
|
---|
15 | my $Is_VMS = $^O eq 'VMS';
|
---|
16 | my $Is_MSWin32 = $^O eq 'MSWin32';
|
---|
17 | my $Is_NetWare = $^O eq 'NetWare';
|
---|
18 |
|
---|
19 | $Shell::capture_stderr = 1;
|
---|
20 |
|
---|
21 | # Now test that that works ..
|
---|
22 |
|
---|
23 | my $tmpfile = 'sht0001';
|
---|
24 | while ( -f $tmpfile ) {
|
---|
25 | $tmpfile++;
|
---|
26 | }
|
---|
27 | END { -f $tmpfile && (open STDERR, '>&SAVERR' and unlink $tmpfile) }
|
---|
28 |
|
---|
29 |
|
---|
30 | open(SAVERR, ">&STDERR");
|
---|
31 | open(STDERR, ">$tmpfile");
|
---|
32 |
|
---|
33 | xXx_not_there(); # Ok someone could have a program called this :(
|
---|
34 |
|
---|
35 | # On os2 the warning is on by default...
|
---|
36 | ok(($^O eq 'os2' xor !(-s $tmpfile)), '$Shell::capture_stderr');
|
---|
37 |
|
---|
38 | $Shell::capture_stderr = 0;
|
---|
39 |
|
---|
40 | # someone will have to fill in the blanks for other platforms
|
---|
41 |
|
---|
42 | if ($Is_VMS) {
|
---|
43 | ok(directory(), 'Execute command');
|
---|
44 | my @files = directory('*.*');
|
---|
45 | ok(@files, 'Quoted arguments');
|
---|
46 |
|
---|
47 | ok(eq_array(\@files, [$so->directory('*.*')]), 'object method');
|
---|
48 | eval { $so->directory };
|
---|
49 | ok(!$@, '2 methods calls');
|
---|
50 | } elsif ($Is_MSWin32) {
|
---|
51 | ok(dir(), 'Execute command');
|
---|
52 | my @files = dir('*.*');
|
---|
53 | ok(@files, 'Quoted arguments');
|
---|
54 |
|
---|
55 | ok(eq_array(\@files, [$so->dir('*.*')]), 'object method');
|
---|
56 | eval { $so->dir };
|
---|
57 | ok(!$@, '2 methods calls');
|
---|
58 | } else {
|
---|
59 | ok(ls(), 'Execute command');
|
---|
60 | my @files = ls('*');
|
---|
61 | ok(@files, 'Quoted arguments');
|
---|
62 |
|
---|
63 | ok(eq_array(\@files, [$so->ls('*')]), 'object method');
|
---|
64 | eval { $so->ls };
|
---|
65 | ok(!$@, '2 methods calls');
|
---|
66 |
|
---|
67 | }
|
---|
68 | open(STDERR, ">&SAVERR") ;
|
---|