cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t

   1 #!perl -w
   2 use strict;
   3 use warnings;
   4 use IO::Pipe;
   5 use Test::Builder;
   6 use Config;
   7
   8 my $b = Test::Builder->new;
   9 $b->reset;
  10
  11 my $Can_Fork = $Config{d_fork}
  12     || (($^O eq 'MSWin32' || $^O eq 'NetWare')
  13     and $Config{useithreads}
  14     and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
  15
  16 if (!$Can_Fork) {
  17     $b->plan('skip_all' => "This system cannot fork");
  18 }
  19 else {
  20     $b->plan('tests' => 2);
  21 }
  22
  23 my $pipe = IO::Pipe->new;
  24 if (my $pid = fork) {
  25     $pipe->reader;
  26     my @output = <$pipe>;
  27     $b->like($output[0], qr/ok 1/,   "ok 1 from child");
  28     $b->like($output[1], qr/1\.\.1/, "got 1..1 from child");
  29     waitpid($pid, 0);
  30 }
  31 else {
  32     Test::Stream::IOSets->hard_reset;
  33     Test::Stream->clear;
  34     $pipe->writer;
  35     my $pipe_fd = $pipe->fileno;
  36     close STDOUT;
  37     open(STDOUT, ">&$pipe_fd");
  38     my $b = Test::Builder->create(shared_stream => 1);
  39     $b->reset;
  40     $b->no_plan;
  41     $b->ok(1);
  42
  43     exit 0;
  44 }
  45
  46 =pod
  47 #actual
  48 1..2
  49 ok 1
  50 1..1
  51 ok 1
  52 ok 2
  53 #expected
  54 1..2
  55 ok 1
  56 ok 2
  57 =cut