1#!/usr/bin/perl -w 2use strict; 3use warnings; 4# HARNESS-NO-STREAM 5# HARNESS-NO-PRELOAD 6 7use Test2::Util qw/CAN_FORK/; 8BEGIN { 9 unless(CAN_FORK) { 10 require Test::More; 11 Test::More->import(skip_all => "fork is not supported"); 12 } 13} 14 15use IO::Pipe; 16use Test::Builder; 17use Test::More; 18 19plan 'skip_all' => "This test cannot be run with the current formatter" 20 unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter'); 21 22plan 'tests' => 1; 23 24subtest 'fork within subtest' => sub { 25 plan tests => 2; 26 27 my $pipe = IO::Pipe->new; 28 my $pid = fork; 29 defined $pid or plan skip_all => "Fork not working"; 30 31 if ($pid) { 32 $pipe->reader; 33 my $child_output = do { local $/ ; <$pipe> }; 34 waitpid $pid, 0; 35 36 is $?, 0, 'child exit status'; 37 like $child_output, qr/^[\s#]+Child Done\s*\z/, 'child output'; 38 } 39 else { 40 $pipe->writer; 41 42 # Force all T::B output into the pipe, for the parent 43 # builder as well as the current subtest builder. 44 my $tb = Test::Builder->new; 45 $tb->output($pipe); 46 $tb->failure_output($pipe); 47 $tb->todo_output($pipe); 48 49 diag 'Child Done'; 50 exit 0; 51 } 52}; 53 54