From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

BEGIN { chdir 't' if -d 't'; };
BEGIN { use lib '../lib'; };
use strict;
### 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 successfully" );
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;
}
}
}