summaryrefslogtreecommitdiff
path: root/cpan/Test-Simple/t/exit.t
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2009-10-02 16:19:41 +0100
committerNicholas Clark <nick@ccl4.org>2009-10-02 16:19:41 +0100
commite0ee75a6976f08f9bc3868227f1cd11ab6507895 (patch)
tree5366acf520d51f2f3961274ced349a4178685be5 /cpan/Test-Simple/t/exit.t
parent8c5b8ff02c62badaeb38078556879720bdf8945a (diff)
downloadperl-e0ee75a6976f08f9bc3868227f1cd11ab6507895.tar.gz
Move Test::Simple from ext/ to cpan/
Diffstat (limited to 'cpan/Test-Simple/t/exit.t')
-rw-r--r--cpan/Test-Simple/t/exit.t114
1 files changed, 114 insertions, 0 deletions
diff --git a/cpan/Test-Simple/t/exit.t b/cpan/Test-Simple/t/exit.t
new file mode 100644
index 0000000000..95661eef07
--- /dev/null
+++ b/cpan/Test-Simple/t/exit.t
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+require Test::Builder;
+my $TB = Test::Builder->create();
+$TB->level(0);
+
+
+package main;
+
+use Cwd;
+use File::Spec;
+
+my $Orig_Dir = cwd;
+
+my $Perl = File::Spec->rel2abs($^X);
+if( $^O eq 'VMS' ) {
+ # VMS can't use its own $^X in a system call until almost 5.8
+ $Perl = "MCR $^X" if $] < 5.007003;
+
+ # Quiet noisy 'SYS$ABORT'
+ $Perl .= q{ -"I../lib"} if $ENV{PERL_CORE};
+ $Perl .= q{ -"Mvmsish=hushed"};
+}
+
+
+eval { require POSIX; &POSIX::WEXITSTATUS(0) };
+if( $@ ) {
+ *exitstatus = sub { $_[0] >> 8 };
+}
+else {
+ *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
+}
+
+
+# Some OS' will alter the exit code to their own native sense...
+# sometimes. Rather than deal with the exception we'll just
+# build up the mapping.
+print "# Building up a map of exit codes. May take a while.\n";
+my %Exit_Map;
+
+open my $fh, ">", "exit_map_test" or die $!;
+print $fh <<'DONE';
+if ($^O eq 'VMS') {
+ require vmsish;
+ import vmsish qw(hushed);
+}
+my $exit = shift;
+print "exit $exit\n";
+END { $? = $exit };
+DONE
+
+close $fh;
+END { 1 while unlink "exit_map_test" }
+
+for my $exit (0..255) {
+ # This correctly emulates Test::Builder's behavior.
+ my $out = qx[$Perl exit_map_test $exit];
+ $TB->like( $out, qr/^exit $exit\n/, "exit map test for $exit" );
+ $Exit_Map{$exit} = exitstatus($?);
+}
+print "# Done.\n";
+
+
+my %Tests = (
+ # File Exit Code
+ 'success.plx' => 0,
+ 'one_fail.plx' => 1,
+ 'two_fail.plx' => 2,
+ 'five_fail.plx' => 5,
+ 'extras.plx' => 2,
+ 'too_few.plx' => 255,
+ 'too_few_fail.plx' => 2,
+ 'death.plx' => 255,
+ 'last_minute_death.plx' => 255,
+ 'pre_plan_death.plx' => 'not zero',
+ 'death_in_eval.plx' => 0,
+ 'require.plx' => 0,
+ 'death_with_handler.plx' => 255,
+ 'exit.plx' => 1,
+ );
+
+chdir 't';
+my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
+while( my($test_name, $exit_code) = each %Tests ) {
+ my $file = File::Spec->catfile($lib, $test_name);
+ my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
+ my $actual_exit = exitstatus($wait_stat);
+
+ if( $exit_code eq 'not zero' ) {
+ $TB->isnt_num( $actual_exit, $Exit_Map{0},
+ "$test_name exited with $actual_exit ".
+ "(expected non-zero)");
+ }
+ else {
+ $TB->is_num( $actual_exit, $Exit_Map{$exit_code},
+ "$test_name exited with $actual_exit ".
+ "(expected $Exit_Map{$exit_code})");
+ }
+}
+
+$TB->done_testing( scalar keys(%Tests) + 256 );
+
+# So any END block file cleanup works.
+chdir $Orig_Dir;