1*5759b3d2Safresh1use strict; 2*5759b3d2Safresh1use warnings; 3*5759b3d2Safresh1# HARNESS-NO-STREAM 4*5759b3d2Safresh1 5*5759b3d2Safresh1use Test2::Util qw/CAN_THREAD/; 6*5759b3d2Safresh1BEGIN { 7*5759b3d2Safresh1 unless(CAN_THREAD) { 8*5759b3d2Safresh1 print "1..0 # Skip threads are not supported.\n"; 9*5759b3d2Safresh1 exit 0; 10*5759b3d2Safresh1 } 11*5759b3d2Safresh1} 12*5759b3d2Safresh1 13*5759b3d2Safresh1BEGIN { 14*5759b3d2Safresh1 unless ( $ENV{AUTHOR_TESTING} ) { 15*5759b3d2Safresh1 print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; 16*5759b3d2Safresh1 exit 0; 17*5759b3d2Safresh1 } 18*5759b3d2Safresh1} 19*5759b3d2Safresh1 20*5759b3d2Safresh1use Test2::IPC; 21*5759b3d2Safresh1use threads; 22*5759b3d2Safresh1use Test::More; 23*5759b3d2Safresh1 24*5759b3d2Safresh1plan 'skip_all' => "This test cannot be run with the current formatter" 25*5759b3d2Safresh1 unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter'); 26*5759b3d2Safresh1 27*5759b3d2Safresh1ok 1 for (1 .. 2); 28*5759b3d2Safresh1 29*5759b3d2Safresh1# used to reset the counter after thread finishes 30*5759b3d2Safresh1my $ct_num = Test::More->builder->current_test; 31*5759b3d2Safresh1 32*5759b3d2Safresh1my $subtest_out = async { 33*5759b3d2Safresh1 my $out = ''; 34*5759b3d2Safresh1 35*5759b3d2Safresh1 #simulate a subtest to not confuse the parent TAP emission 36*5759b3d2Safresh1 my $tb = Test::More->builder; 37*5759b3d2Safresh1 $tb->reset; 38*5759b3d2Safresh1 for (qw/output failure_output todo_output/) { 39*5759b3d2Safresh1 close $tb->$_; 40*5759b3d2Safresh1 open($tb->$_, '>', \$out); 41*5759b3d2Safresh1 } 42*5759b3d2Safresh1 43*5759b3d2Safresh1 ok 1 for (1 .. 3); 44*5759b3d2Safresh1 45*5759b3d2Safresh1 done_testing; 46*5759b3d2Safresh1 47*5759b3d2Safresh1 close $tb->$_ for (qw/output failure_output todo_output/); 48*5759b3d2Safresh1 49*5759b3d2Safresh1 $out; 50*5759b3d2Safresh1} 51*5759b3d2Safresh1->join; 52*5759b3d2Safresh1 53*5759b3d2Safresh1$subtest_out =~ s/^/ /gm; 54*5759b3d2Safresh1print $subtest_out; 55*5759b3d2Safresh1 56*5759b3d2Safresh1# reset as if the thread never "said" anything 57*5759b3d2Safresh1Test::More->builder->current_test($ct_num); 58*5759b3d2Safresh1 59*5759b3d2Safresh1ok 1 for (1 .. 4); 60*5759b3d2Safresh1 61*5759b3d2Safresh1done_testing; 62