cpan/Test-Harness/t/nofork.t

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