summaryrefslogtreecommitdiff
path: root/lib/Shell.t
blob: 13bba2255e9cd04b6fcfadbc533e369704bbbb71 (plain)
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
#!./perl

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
}

use Test::More tests => 7;

BEGIN { use_ok('Shell'); }

my $so = Shell->new;
ok($so, 'Shell->new');

my $Is_VMS     = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $Is_NetWare = $^O eq 'NetWare';

$Shell::capture_stderr = 1;

# Now test that that works ..

my $tmpfile = 'sht0001';
while ( -f $tmpfile ) {
    $tmpfile++;
}
END { -f $tmpfile && (open STDERR, '>&SAVERR' and unlink $tmpfile) }

no warnings 'once'; 
# no false warning about   Name "main::SAVERR" used only once: possible typo

open(SAVERR, ">&STDERR");
open(STDERR, ">$tmpfile");

xXx_not_there();  # Ok someone could have a program called this :(

# On os2 the warning is on by default...
ok(($^O eq 'os2' xor !(-s $tmpfile)), '$Shell::capture_stderr');

$Shell::capture_stderr = 0;

# Trying to do two repeated C<ls>s in t in core and expecting the same output
# is a race condition when tests are running in parallel, and using it as a
# temporary directory. So go somewhere quieter.
if ($ENV{PERL_CORE} && -d 'uni') {
  chdir 'uni';
  $chdir++;
}

# someone will have to fill in the blanks for other platforms

if ($Is_VMS) {
    ok(directory(), 'Execute command');
    my @files = directory('*.*');
    ok(@files, 'Quoted arguments');

    ok(eq_array(\@files, [$so->directory('*.*')]), 'object method');
    eval { $so->directory };
    ok(!$@, '2 methods calls');
} elsif ($Is_MSWin32) {
    ok(dir(), 'Execute command');
    my @files = dir('*.*');
    ok(@files, 'Quoted arguments');

    ok(eq_array(\@files, [$so->dir('*.*')]), 'object method');
    eval { $so->dir };
    ok(!$@, '2 methods calls');
} else {
    ok(ls(), 'Execute command');
    my @files = ls('*');
    ok(@files, 'Quoted arguments');

    ok(eq_array(\@files, [$so->ls('*')]), 'object method');
    eval { $so->ls };
    ok(!$@, '2 methods calls');

}
open(STDERR, ">&SAVERR") ;

if ($chdir) {
  chdir "..";
}