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