1b39c5158Smillert#!/usr/bin/perl -w 2b39c5158Smillert 3b39c5158Smillert# check nofork logic on systems which *can* fork() 4b39c5158Smillert# NOTE maybe a good candidate for xt/author or something. 5b39c5158Smillert 6898184e3SsthenBEGIN { 7b39c5158Smillert use lib 't/lib'; 8898184e3Ssthen} 9b39c5158Smillert 10b39c5158Smillertuse strict; 11*6fb12b70Safresh1use warnings; 12b39c5158Smillert 13b39c5158Smillertuse Config; 14b39c5158Smillertuse Test::More ( 15b39c5158Smillert $Config{d_fork} 16b39c5158Smillert ? 'no_plan' 17b39c5158Smillert : ( 'skip_all' => 'your system already has no fork' ) 18b39c5158Smillert); 19b39c5158Smillertuse IO::c55Capture; # for util 20b39c5158Smillert 21b39c5158Smillertuse TAP::Harness; 22b39c5158Smillert 23b39c5158Smillertsub backticks { 24b39c5158Smillert my (@args) = @_; 25b39c5158Smillert 26b39c5158Smillert util::stdout_of( sub { system(@args) and die "error $?" } ); 27b39c5158Smillert} 28b39c5158Smillert 29b39c5158Smillertmy @libs = map "-I$_", @INC; 30b39c5158Smillertmy @perl = ( $^X, @libs ); 31b39c5158Smillertmy $mod = 'TAP::Parser::Iterator::Process'; 32b39c5158Smillert 33b39c5158Smillert{ # just check the introspective method to start... 34b39c5158Smillert my $code = qq(print $mod->_use_open3 ? 1 : 2); 35b39c5158Smillert { 36b39c5158Smillert my $ans = backticks( @perl, '-MNoFork', "-M$mod", '-e', $code ); 37b39c5158Smillert is( $ans, 2, 'says not to fork' ); 38b39c5158Smillert } 39b39c5158Smillert { 40b39c5158Smillert local $ENV{PERL5OPT}; # punt: prevent propogating -MNoFork 41b39c5158Smillert my $ans = backticks( @perl, "-M$mod", '-e', $code ); 42b39c5158Smillert is( $ans, 1, 'says to fork' ); 43b39c5158Smillert } 44b39c5158Smillert} 45b39c5158Smillert 46b39c5158Smillert{ # and make sure we can run a test 47b39c5158Smillert my $capture = IO::c55Capture->new_handle; 48b39c5158Smillert local *STDERR; 49b39c5158Smillert my $harness = TAP::Harness->new( 50b39c5158Smillert { verbosity => -2, 51b39c5158Smillert switches => [ @libs, "-MNoFork" ], 52b39c5158Smillert stdout => $capture, 53b39c5158Smillert } 54b39c5158Smillert ); 55b39c5158Smillert $harness->runtests('t/sample-tests/simple'); 56b39c5158Smillert my @output = tied($$capture)->dump; 57b39c5158Smillert is pop @output, "Result: PASS\n", 'status OK'; 58b39c5158Smillert pop @output; # get rid of summary line 59b39c5158Smillert is( $output[-1], "All tests successful.\n", 'ran with no fork' ); 60b39c5158Smillert} 61b39c5158Smillert 62b39c5158Smillert# vim:ts=4:sw=4:et:sta 63