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