cpan/Test-Simple/t/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') and
  13                 $Config{useithreads} and
  14                 $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
  15                );
  16
  17 if( !$Can_Fork ) {
  18     $b->plan('skip_all' => "This system cannot fork");
  19 }
  20 else {
  21     $b->plan('tests' => 2);
  22 }
  23
  24 my $pipe = IO::Pipe->new;
  25 if ( my $pid = fork ) {
  26   $pipe->reader;
  27   $b->ok((<$pipe> =~ /FROM CHILD: ok 1/), "ok 1 from child");
  28   $b->ok((<$pipe> =~ /FROM CHILD: 1\.\.1/), "1..1 from child");
  29   waitpid($pid, 0);
  30 }
  31 else {
  32   $pipe->writer;
  33   my $pipe_fd = $pipe->fileno;
  34   close STDOUT;
  35   open(STDOUT, ">&$pipe_fd");
  36   my $b = Test::Builder->new;
  37   $b->reset;
  38   $b->no_plan;
  39   $b->ok(1);
  40 }
  41
  42
  43 =pod
  44 #actual
  45 1..2
  46 ok 1
  47 1..1
  48 ok 1
  49 ok 2
  50 #expected
  51 1..2
  52 ok 1
  53 ok 2
  54 =cut