| 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 | } |
projects / p5sagit/p5-mst-13.2.git / blame