ext/Shell/t/Shell.t

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