Commit | Line | Data |
bdd3a62b |
1 | BEGIN { chdir 't' if -d 't'; }; |
2 | BEGIN { use lib '../lib'; }; |
e3f7a951 |
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 | } |