1BEGIN { chdir 't' if -d 't'; };
2BEGIN { use lib '../lib'; };
3
4use strict;
5use File::Spec;
6
7### only run interactive tests when there's someone that can answer them
8use Test::More -t STDOUT
9                    ? 'no_plan'
10                    : ( skip_all => "No interactive tests from harness" );
11
12my $Class   = 'IPC::Cmd';
13my $Child   = File::Spec->catfile( qw[src child.pl] );
14my @FDs     = 0..20;
15my $IsWin32 = $^O eq 'MSWin32';
16
17use_ok( $Class, 'run' );
18$IPC::Cmd::DEBUG = 1;
19
20my $Have_IPC_Run    = $Class->can_use_ipc_run;
21my $Have_IPC_Open3  = $Class->can_use_ipc_open3;
22
23### configurations to test IPC::Cmd with
24my @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
47my @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
58for 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}
111