02_interactive.t

source of perl for linux application,

BEGIN { chdir 't' if -d 't' };
BEGIN { use lib '../lib' };

use strict;
use File::Spec;

### only run interactive tests when there's someone that can answer them
use Test::More -t STDOUT
                    ? 'no_plan' 
                    : ( skip_all => "No interactive tests from harness" );

my $Class   = 'IPC::Cmd';
my $Child   = File::Spec->catfile( qw[src child.pl] );
my @FDs     = 0..20;
my $IsWin32 = $^O eq 'MSWin32';

use_ok( $Class, 'run' );
$IPC::Cmd::DEBUG = 1;

my $Have_IPC_Run    = $Class->can_use_ipc_run;
my $Have_IPC_Open3  = $Class->can_use_ipc_open3;

### configurations to test IPC::Cmd with
my @Conf = ( 
    [ $Have_IPC_Run, $Have_IPC_Open3 ], 
    [ 0,             $Have_IPC_Open3 ], 
    [ 0,             0 ] 
);




### first, check which FD's are open. they should be open
### /after/ we run our tests as well.
### 0, 1 and 2 should be open, as they are STDOUT, STDERR and STDIN
### XXX 2 are opened by Test::Builder at least.. this is 'whitebox'
### knowledge, so unsafe to test against. around line 1322:
# sub _open_testhandles {
#     return if $Opened_Testhandles;
#     # We dup STDOUT and STDERR so people can change them in their
#     # test suites while still getting normal test output.
#     open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
#     open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";
#     $Opened_Testhandles = 1;
# }

my @Opened;
{   for ( @FDs ) {
        my $fh;
        my $rv = open $fh, "<&$_";
        push @Opened, $_ if $rv;
    }
    diag( "Opened FDs: @Opened" );
    cmp_ok( scalar(@Opened), '>=', 3,
                                "At least 3 FDs are opened" );
}

for my $aref ( @Conf ) {

    ### stupid warnings
    local $IPC::Cmd::USE_IPC_RUN    = $aref->[0];
    local $IPC::Cmd::USE_IPC_RUN    = $aref->[0];

    local $IPC::Cmd::USE_IPC_OPEN3  = $aref->[1];
    local $IPC::Cmd::USE_IPC_OPEN3  = $aref->[1];

    diag("Config: IPC::Run = $aref->[0] IPC::Open3 = $aref->[1]");
    ok( -t STDIN,               "STDIN attached to a tty" );
    
    for my $cmd ( qq[$^X $Child], qq[$^X $Child | $^X -neprint] ) {
    
        diag("Please enter some input. It will be echo'd back to you");
        my $buffer;
        my $ok = run( command => $cmd, verbose => 1, buffer => \$buffer );
    
        ok( $ok,                    "   Command '$cmd' ran succesfully" );
    
        SKIP: {
            skip "No buffers available", 1 unless $Class->can_capture_buffer;
            ok( defined $buffer,    "   Input captured" );
        }
    }
}

### check we didnt leak any FHs
{   ### should be opened
    my %open = map { $_ => 1 } @Opened;
    
    for ( @FDs ) {
        my $fh;
        my $rv = open $fh, "<&=$_";
     
        ### these should be open 
        if( $open{$_} ) {
            ok( $rv,                "FD $_ opened" );
            ok( $fh,                "   FH indeed opened" );
            is( fileno($fh), $_,    "   Opened at the correct fileno($_)" );
        } else {
            ok( !$rv,               "FD $_ not opened" );
            ok( !(fileno($fh)),     "   FH indeed closed" );

            ### extra debug info if tests fail
#             use Devel::Peek;
#             use Data::Dumper;
#             diag( "RV=$rv FH=$fh Fileno=". fileno($fh). Dump($fh) ) if $rv;
#             diag( Dumper( [stat $fh] ) )                            if $rv;

        }
    }
}