cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t

   1 use strict;
   2 use warnings;
   3 use Test2::IPC;
   4 use Test2::Tools::Tiny;
   5 use Test2::API qw/context test2_stack/;
   6 use Test2::Util qw/CAN_FORK/;
   7
   8 BEGIN {
   9     skip_all "System cannot fork" unless CAN_FORK;
  10     skip_all "known to fail on $]" if $] le "5.006002";
  11 }
  12
  13 plan(3);
  14
  15 pipe(my ($read, $write));
  16
  17 test2_stack()->top;
  18 my $hub = test2_stack()->new_hub();
  19
  20 my $pid = fork();
  21 die "Failed to fork" unless defined $pid;
  22
  23 if ($pid) {
  24     close($read);
  25     test2_stack()->pop($hub);
  26     $hub = undef;
  27     print $write "Go\n";
  28     close($write);
  29     waitpid($pid, 0);
  30     my $err = $? >> 8;
  31     is($err, 255, "Exit code was not masked");
  32     ok($err != 100, "Did not hit the safety exit");
  33 }
  34 else {
  35     close($write);
  36     my $ignore = <$read>;
  37     close($read);
  38     close(STDERR);
  39     close(STDOUT);
  40     open(STDERR, '>', my $x);
  41     my $ctx = context(hub => $hub, level => -1);
  42     my $clone = $ctx->snapshot;
  43     $ctx->release;
  44     $clone->ok(0, "Should not see this");
  45     print STDERR "\n\nSomething went wrong!!!!\n\n";
  46     exit 100; # Safety exit
  47 };
  48
  49
  50 # The rest of this is to make sure nothing that happens when reading the event
  51 # messes with $?.
  52
  53 pipe($read, $write);
  54
  55 $pid = fork;
  56 die "Failed to fork" unless defined $pid;
  57
  58 unless($pid) {
  59     my $ignore = <$read>;
  60     ok(1, "Test in forked process");
  61 }
  62
  63 print $write "Go\n";