1use strict; 2use warnings; 3use Test2::IPC; 4use Test2::Tools::Tiny; 5use Test2::API qw/context intercept test2_stack/; 6use Test2::Util qw/CAN_FORK/; 7 8BEGIN { 9 skip_all "System cannot fork" unless CAN_FORK; 10} 11 12my $events = intercept { 13 Test2::API::run_subtest("this subtest forks" => sub { 14 if (fork) { 15 wait; 16 isnt($?, 0, "subprocess died"); 17 } else { 18 # Prevent the exception from being rendered to STDERR, people have 19 # complained about STDERR noise in tests before. 20 close STDERR; 21 die "# Expected warning from subtest"; 22 }; 23 }, {no_fork => 1}); 24}; 25 26my @subtests = grep {; $_->isa('Test2::Event::Subtest') } @$events; 27 28if (is(@subtests, 1, "only one subtest run, effectively")) { 29 my @subokay = grep {; $_->facets->{assert} } 30 @{ $subtests[0]->subevents }; 31 is(@subokay, 1, "we got one test result inside the subtest"); 32 ok(! $subokay[0]->causes_fail, "...and it passed"); 33} else { 34 # give up, we're already clearly broken 35} 36 37done_testing; 38