t/run/exit.t

   1 #! perl
   2 # Copyright (C) 2001-2004, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/run/exit.t - test parrot exit codes
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/run/exit.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests C<Parrot> exit codes. Tests variations of normal and abnormal exit
  16 with combinations of STDERR and STDOUT open and closed.  Also tests behavior
  17 under error conditions, whether output files are created and whether the error
  18 is returned properly.
  19
  20 =cut
  21
  22 use strict;
  23 use warnings;
  24 use lib qw( . lib ../lib ../../lib );
  25
  26 use Test::More;
  27 use Parrot::Test tests => 10;
  28 use Parrot::Config;
  29 use File::Spec;
  30 use File::Temp qw(tempdir);
  31 use IO::File;
  32
  33 my $PARROT = ".$PConfig{slash}$PConfig{test_prog}";
  34 my $redir  = File::Spec->devnull;
  35
  36 # copy file descriptors
  37 open *OLDOUT, ">&STDOUT" or die qq|Cannot dup STDOUT: $!|;    ## no critic
  38 open *OLDERR, ">&STDERR" or die qq|Cannot dup STDERR: $!|;    ## no critic
  39
  40 sub exits {
  41     my $pre = shift;
  42     $pre ||= '';
  43
  44     is( system(qq|$PARROT --version $redir > $redir 2> $redir|) >> 8, 0, "$pre: normal exit" );
  45     isnt( system(qq|$PARROT --foo $redir > $redir 2> $redir|) >> 8, 0, "$pre: abnormal exit" );
  46 }
  47
  48 # all open
  49 exits('STDERR & STDOUT open');
  50
  51 # close stderr
  52 close *STDERR or die qq|Cannot close STDERR: $!|;
  53 exits('STDERR closed');
  54
  55 # close stdout too
  56 close *STDOUT or die qq|Cannot close STDOUT: $!|;
  57 exits('STDERR & STDOUT closed');
  58
  59 # restore stderr
  60 open *STDERR, ">&OLDERR" or die qq|Cannot restore stderr: $!|;    ## no critic
  61 exits('STDOUT closed');
  62
  63 # restore stdout
  64 open *STDOUT, ">&OLDOUT" or die qq|Cannot restore stdout: $!|;    ## no critic
  65
  66 # close copies
  67 close *OLDOUT or die qq|Cannot close OLDOUT: $!|;
  68 close *OLDERR or die qq|Cannot close OLDERR: $!|;
  69
  70 # exits nonzero on a parse error
  71 my $tempdir = tempdir(CLEANUP => 1);
  72 my $pirfn = File::Spec->catfile($tempdir, "test.pir");
  73 my $pbcfn = File::Spec->catfile($tempdir, "test.pbc");
  74 my $pirfile = IO::File->new(">$pirfn");
  75 $pirfile->print("Parse error.\n");
  76 $pirfile->close();
  77 my $rv = system(qq|$PARROT -o $pbcfn $pirfn $redir > $redir 2> $redir|) >> 8;
  78 isnt($rv, 0, "parrot returns error on parse failure\n");
  79 ok(! -e $pbcfn, "parrot doesn't create outfile on parse failure\n");
  80
  81 # Local Variables:
  82 #   mode: cperl
  83 #   cperl-indent-level: 4
  84 #   fill-column: 100
  85 # End:
  86 # vim: expandtab shiftwidth=4: