lib/IPC/Cmd/t/02_Interactive.t

   1 BEGIN { chdir 't' if -d 't'; };
   2 BEGIN { use lib '../lib'; };
   3
   4 use strict;
   5 use File::Spec;
   6
   7 ### only run interactive tests when there's someone that can answer them
   8 use Test::More -t STDOUT
   9                     ? 'no_plan'
  10                     : ( skip_all => "No interactive tests from harness" );
  11
  12 my $Class   = 'IPC::Cmd';
  13 my $Child   = File::Spec->catfile( qw[src child.pl] );
  14 my @FDs     = 0..20;
  15 my $IsWin32 = $^O eq 'MSWin32';
  16
  17 use_ok( $Class, 'run' );
  18 $IPC::Cmd::DEBUG = 1;
  19
  20 my $Have_IPC_Run    = $Class->can_use_ipc_run;
  21 my $Have_IPC_Open3  = $Class->can_use_ipc_open3;
  22
  23 ### configurations to test IPC::Cmd with
  24 my @Conf = (
  25     [ $Have_IPC_Run, $Have_IPC_Open3 ],
  26     [ 0,             $Have_IPC_Open3 ],
  27     [ 0,             0 ]
  28 );
  29
  30
  31
  32
  33 ### first, check which FD's are open. they should be open
  34 ### /after/ we run our tests as well.
  35 ### 0, 1 and 2 should be open, as they are STDOUT, STDERR and STDIN
  36 ### XXX 2 are opened by Test::Builder at least.. this is 'whitebox'
  37 ### knowledge, so unsafe to test against. around line 1322:
  38 # sub _open_testhandles {
  39 #     return if $Opened_Testhandles;
  40 #     # We dup STDOUT and STDERR so people can change them in their
  41 #     # test suites while still getting normal test output.
  42 #     open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
  43 #     open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";
  44 #     $Opened_Testhandles = 1;
  45 # }
  46
  47 my @Opened;
  48 {   for ( @FDs ) {
  49         my $fh;
  50         my $rv = open $fh, "<&$_";
  51         push @Opened, $_ if $rv;
  52     }
  53     diag( "Opened FDs: @Opened" );
  54     cmp_ok( scalar(@Opened), '>=', 3,
  55                                 "At least 3 FDs are opened" );
  56 }
  57
  58 for my $aref ( @Conf ) {
  59
  60     ### stupid warnings
  61     local $IPC::Cmd::USE_IPC_RUN    = $aref->[0];
  62     local $IPC::Cmd::USE_IPC_RUN    = $aref->[0];
  63
  64     local $IPC::Cmd::USE_IPC_OPEN3  = $aref->[1];
  65     local $IPC::Cmd::USE_IPC_OPEN3  = $aref->[1];
  66
  67     diag("Config: IPC::Run = $aref->[0] IPC::Open3 = $aref->[1]");
  68     ok( -t STDIN,               "STDIN attached to a tty" );
  69
  70     for my $cmd ( qq[$^X $Child], qq[$^X $Child | $^X -neprint] ) {
  71
  72         diag("Please enter some input. It will be echo'd back to you");
  73         my $buffer;
  74         my $ok = run( command => $cmd, verbose => 1, buffer => \$buffer );
  75
  76         ok( $ok,                    "   Command '$cmd' ran succesfully" );
  77
  78         SKIP: {
  79             skip "No buffers available", 1 unless $Class->can_capture_buffer;
  80             ok( defined $buffer,    "   Input captured" );
  81         }
  82     }
  83 }
  84
  85 ### check we didnt leak any FHs
  86 {   ### should be opened
  87     my %open = map { $_ => 1 } @Opened;
  88
  89     for ( @FDs ) {
  90         my $fh;
  91         my $rv = open $fh, "<&=$_";
  92
  93         ### these should be open
  94         if( $open{$_} ) {
  95             ok( $rv,                "FD $_ opened" );
  96             ok( $fh,                "   FH indeed opened" );
  97             is( fileno($fh), $_,    "   Opened at the correct fileno($_)" );
  98         } else {
  99             ok( !$rv,               "FD $_ not opened" );
 100             ok( !(fileno($fh)),     "   FH indeed closed" );
 101
 102             ### extra debug info if tests fail
 103 #             use Devel::Peek;
 104 #             use Data::Dumper;
 105 #             diag( "RV=$rv FH=$fh Fileno=". fileno($fh). Dump($fh) ) if $rv;
 106 #             diag( Dumper( [stat $fh] ) )                            if $rv;
 107
 108         }
 109     }
 110 }