lib/Shell.t

   1 #!./perl
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use Test::More tests => 7;
  11
  12 BEGIN { use_ok('Shell'); }
  13
  14 my $so = Shell->new;
  15 ok($so, 'Shell->new');
  16
  17 my $Is_VMS     = $^O eq 'VMS';
  18 my $Is_MSWin32 = $^O eq 'MSWin32';
  19 my $Is_NetWare = $^O eq 'NetWare';
  20
  21 $Shell::capture_stderr = 1;
  22
  23 # Now test that that works ..
  24
  25 my $tmpfile = 'sht0001';
  26 while ( -f $tmpfile ) {
  27     $tmpfile++;
  28 }
  29 END { -f $tmpfile && (open STDERR, '>&SAVERR' and unlink $tmpfile) }
  30
  31 no warnings 'once';
  32 # no false warning about   Name "main::SAVERR" used only once: possible typo
  33
  34 open(SAVERR, ">&STDERR");
  35 open(STDERR, ">$tmpfile");
  36
  37 xXx_not_there();  # Ok someone could have a program called this :(
  38
  39 # On os2 the warning is on by default...
  40 ok(($^O eq 'os2' xor !(-s $tmpfile)), '$Shell::capture_stderr');
  41
  42 $Shell::capture_stderr = 0;
  43
  44 # Trying to do two repeated C<ls>s in t in core and expecting the same output
  45 # is a race condition when tests are running in parallel, and using it as a
  46 # temporary directory. So go somewhere quieter.
  47 if ($ENV{PERL_CORE} && -d 'uni') {
  48   chdir 'uni';
  49   $chdir++;
  50 }
  51
  52 # someone will have to fill in the blanks for other platforms
  53
  54 if ($Is_VMS) {
  55     ok(directory(), 'Execute command');
  56     my @files = directory('*.*');
  57     ok(@files, 'Quoted arguments');
  58
  59     ok(eq_array(\@files, [$so->directory('*.*')]), 'object method');
  60     eval { $so->directory };
  61     ok(!$@, '2 methods calls');
  62 } elsif ($Is_MSWin32) {
  63     ok(dir(), 'Execute command');
  64     my @files = dir('*.*');
  65     ok(@files, 'Quoted arguments');
  66
  67     ok(eq_array(\@files, [$so->dir('*.*')]), 'object method');
  68     eval { $so->dir };
  69     ok(!$@, '2 methods calls');
  70 } else {
  71     ok(ls(), 'Execute command');
  72     my @files = ls('*');
  73     ok(@files, 'Quoted arguments');
  74
  75     ok(eq_array(\@files, [$so->ls('*')]), 'object method');
  76     eval { $so->ls };
  77     ok(!$@, '2 methods calls');
  78
  79 }
  80 open(STDERR, ">&SAVERR") ;
  81
  82 if ($chdir) {
  83   chdir "..";
  84 }