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