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") ;