use strict;
use lib qw[../lib];
-use File::Spec ();
+use File::Spec;
use Test::More 'no_plan';
-my $Class = 'IPC::Cmd';
-my @Funcs = qw[run can_run];
-my @Meths = qw[can_use_ipc_run can_use_ipc_open3 can_capture_buffer];
-my $IsWin32 = $^O eq 'MSWin32';
-my $Verbose = @ARGV ? 1 : 0;
+my $Class = 'IPC::Cmd';
+my $AClass = $Class . '::TimeOut';
+my @Funcs = qw[run can_run QUOTE];
+my @Meths = qw[can_use_ipc_run can_use_ipc_open3 can_capture_buffer];
+my $IsWin32 = $^O eq 'MSWin32';
+my $Verbose = @ARGV ? 1 : 0;
use_ok( $Class, $_ ) for @Funcs;
can_ok( $Class, $_ ) for @Funcs, @Meths;
can_ok( __PACKAGE__, $_ ) for @Funcs;
-my $Have_IPC_Run = $Class->can_use_ipc_run;
-my $Have_IPC_Open3 = $Class->can_use_ipc_open3;
+my $Have_IPC_Run = $Class->can_use_ipc_run || 0;
+my $Have_IPC_Open3 = $Class->can_use_ipc_open3 || 0;
+
+diag("IPC::Run: $Have_IPC_Run IPC::Open3: $Have_IPC_Open3");
+
+local $IPC::Cmd::VERBOSE = $Verbose;
+local $IPC::Cmd::VERBOSE = $Verbose;
+local $IPC::Cmd::DEBUG = $Verbose;
+local $IPC::Cmd::DEBUG = $Verbose;
-$IPC::Cmd::VERBOSE = $IPC::Cmd::VERBOSE = $Verbose;
### run tests in various configurations, based on what modules we have
-my @Prefs = (
- [ $Have_IPC_Run, $Have_IPC_Open3 ],
- [ 0, $Have_IPC_Open3 ],
- [ 0, 0 ]
-);
+my @Prefs = ( );
+push @Prefs, [ $Have_IPC_Run, $Have_IPC_Open3 ] if $Have_IPC_Run;
+
+### run this config twice to ensure FD restores work properly
+push @Prefs, [ 0, $Have_IPC_Open3 ],
+ [ 0, $Have_IPC_Open3 ] if $Have_IPC_Open3;
+
+### run this config twice to ensure FD restores work properly
+### these are the system() tests;
+push @Prefs, [ 0, 0 ], [ 0, 0 ];
+
### can_run tests
{
ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
}
-### run tests that print only to stdout
-{ ### list of commands and regexes matching output ###
+{ ### list of commands and regexes matching output
+ ### XXX use " everywhere when using literal strings as commands for
+ ### portability, especially on win32
my $map = [
- # command # output regex
- [ "$^X -v", qr/larry\s+wall/i, ],
- [ [$^X, '-v'], qr/larry\s+wall/i, ],
- [ "$^X -eprint+42 | $^X -neprint", qr/42/, ],
- [ [$^X,qw[-eprint+42 |], $^X, qw|-neprint|], qr/42/, ],
+ # command # output regex # buffer
+
+ ### run tests that print only to stdout
+ [ "$^X -v", qr/larry\s+wall/i, 3, ],
+ [ [$^X, '-v'], qr/larry\s+wall/i, 3, ],
+
+ ### pipes
+ [ "$^X -eprint+424 | $^X -neprint+split+2", qr/44/, 3, ],
+ [ [$^X,qw[-eprint+424 |], $^X, qw|-neprint+split+2|],
+ qr/44/, 3, ],
+ ### whitespace
+ [ [$^X, '-eprint+shift', q|a b a|], qr/a b a/, 3, ],
+ [ qq[$^X -eprint+shift "a b a"], qr/a b a/, 3, ],
+
+ ### whitespace + pipe
+ [ [$^X, '-eprint+shift', q|a b a|, q[|], $^X, qw[-neprint+split+b] ],
+ qr/a a/, 3, ],
+ [ qq[$^X -eprint+shift "a b a" | $^X -neprint+split+b],
+ qr/a a/, 3, ],
+
+ ### run tests that print only to stderr
+ [ "$^X -ewarn+42", qr/^42 /, 4, ],
+ [ [$^X, '-ewarn+42'], qr/^42 /, 4, ],
];
- diag( "Running tests that print only to stdout" ) if $Verbose;
+ ### extended test in developer mode
+ ### test if gzip | tar works
+ if( $Verbose ) {
+ my $gzip = can_run('gzip');
+ my $tar = can_run('tar');
+
+ if( $gzip and $tar ) {
+ push @$map,
+ [ [$gzip, qw[-cdf src/x.tgz |], $tar, qw[-tf -]],
+ qr/a/, 3, ];
+ }
+ }
+
### for each configuarion
for my $pref ( @Prefs ) {
- diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
- if $Verbose;
- $IPC::Cmd::USE_IPC_RUN = $IPC::Cmd::USE_IPC_RUN = $pref->[0];
- $IPC::Cmd::USE_IPC_OPEN3 = $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1];
+ local $IPC::Cmd::USE_IPC_RUN = !!$pref->[0];
+ local $IPC::Cmd::USE_IPC_RUN = !!$pref->[0];
+ local $IPC::Cmd::USE_IPC_OPEN3 = !!$pref->[1];
+ local $IPC::Cmd::USE_IPC_OPEN3 = !!$pref->[1];
### for each command
for my $aref ( @$map ) {
- my $cmd = $aref->[0];
- my $regex = $aref->[1];
+ my $cmd = $aref->[0];
+ my $regex = $aref->[1];
+ my $index = $aref->[2];
- my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
- diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") )
- if $Verbose;
+ my $pp_cmd = ref $cmd ? "Array: @$cmd" : "Scalar: $cmd";
+ $pp_cmd .= " (IPC::Run: $pref->[0] IPC::Open3: $pref->[1])";
+
+ diag( "Running '$pp_cmd'") if $Verbose;
### in scalar mode
- { diag( "Running scalar mode" ) if $Verbose;
- my $buffer;
+ { my $buffer;
my $ok = run( command => $cmd, buffer => \$buffer );
- ok( $ok, "Ran command succesfully" );
+ ok( $ok, "Ran '$pp_cmd' command succesfully" );
SKIP: {
skip "No buffers available", 1
unless $Class->can_capture_buffer;
like( $buffer, $regex,
- " Buffer filled properly" );
+ " Buffer matches $regex -- ($pp_cmd)" );
}
}
### in list mode
{ diag( "Running list mode" ) if $Verbose;
my @list = run( command => $cmd );
- ok( $list[0], "Command ran successfully" );
- ok( !$list[1], " No error code set" );
+
+ ok( $list[0], "Ran '$pp_cmd' successfully" );
+ ok( !$list[1], " No error code set -- ($pp_cmd)" );
my $list_length = $Class->can_capture_buffer ? 5 : 2;
is( scalar(@list), $list_length,
- " Output list has $list_length entries" );
+ " Output list has $list_length entries -- ($pp_cmd)" );
SKIP: {
skip "No buffers available", 6
isa_ok( $list[$_], 'ARRAY' ) for 2..4;
like( "@{$list[2]}", $regex,
- " Combined buffer holds output" );
+ " Combined buffer matches $regex -- ($pp_cmd)" );
- like( "@{$list[3]}", qr/$regex/,
- " Stdout buffer filled" );
- is( scalar( @{$list[4]} ), 0,
- " Stderr buffer empty" );
+ like( "@{$list[$index]}", qr/$regex/,
+ " Proper buffer($index) matches $regex -- ($pp_cmd)" );
+ is( scalar( @{$list[ $index==3 ? 4 : 3 ]} ), 0,
+ " Other buffer empty -- ($pp_cmd)" );
}
}
}
}
}
+__END__
+### special call to check that output is interleaved properly
+{ my $cmd = [$^X, File::Spec->catfile( qw[src output.pl] ) ];
-### run tests that print only to stderr
-### XXX lots of duplication from stdout tests, only difference
-### is buffer inspection
-{ ### list of commands and regexes matching output ###
- my $map = [
- # command # output regex
- [ "$^X -ewarn+42", qr/^42 /, ],
- [ [$^X, '-ewarn+42'], qr/^42 /, ],
- ];
-
- diag( "Running tests that print only to stderr" ) if $Verbose;
### for each configuarion
for my $pref ( @Prefs ) {
diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
if $Verbose;
- $IPC::Cmd::USE_IPC_RUN = $IPC::Cmd::USE_IPC_RUN = $pref->[0];
- $IPC::Cmd::USE_IPC_OPEN3 = $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1];
-
- ### for each command
- for my $aref ( @$map ) {
- my $cmd = $aref->[0];
- my $regex = $aref->[1];
-
- my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
- diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") )
- if $Verbose;
+ local $IPC::Cmd::USE_IPC_RUN = $pref->[0];
+ local $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1];
- ### in scalar mode
- { diag( "Running stderr command in scalar mode" ) if $Verbose;
- my $buffer;
- my $ok = run( command => $cmd, buffer => \$buffer );
+ my @list = run( command => $cmd, buffer => \my $buffer );
+ ok( $list[0], "Ran @{$cmd} successfully" );
+ ok( !$list[1], " No errorcode set" );
+ SKIP: {
+ skip "No buffers available", 3 unless $Class->can_capture_buffer;
- ok( $ok, "Ran stderr command succesfully in scalar mode." );
+ TODO: {
+ local $TODO = qq[Can't interleave input/output buffers yet];
- SKIP: {
- # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
- skip "No buffers available", 1
- unless $Class->can_capture_buffer;
-
- like( $buffer, $regex,
- " Buffer filled properly from stderr" );
- }
- }
-
- ### in list mode
- { diag( "Running stderr command in list mode" ) if $Verbose;
- my @list = run( command => $cmd );
- ok( $list[0], "Ran stderr command successfully in list mode." );
- ok( !$list[1], " No error code set" );
-
- my $list_length = $Class->can_capture_buffer ? 5 : 2;
- is( scalar(@list), $list_length,
- " Output list has $list_length entries" );
-
- SKIP: {
- # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
- skip "No buffers available", 6
- unless $Class->can_capture_buffer;
-
- ### the last 3 entries from the RV, are they array refs?
- isa_ok( $list[$_], 'ARRAY' ) for 2..4;
-
- like( "@{$list[2]}", $regex,
- " Combined buffer holds output" );
-
- is( scalar( @{$list[3]} ), 0,
- " Stdout buffer empty" );
- like( "@{$list[4]}", qr/$regex/,
- " Stderr buffer filled" );
- }
+ is( "@{$list[2]}",'1 2 3 4'," Combined output as expected" );
+ is( "@{$list[3]}", '1 3', " STDOUT as expected" );
+ is( "@{$list[4]}", '2 4', " STDERR as expected" );
+
}
}
- }
+ }
}
+
+
### test failures
{ ### for each configuarion
for my $pref ( @Prefs ) {
diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
if $Verbose;
- $IPC::Cmd::USE_IPC_RUN = $IPC::Cmd::USE_IPC_RUN = $pref->[0];
- $IPC::Cmd::USE_IPC_OPEN3 = $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1];
+ local $IPC::Cmd::USE_IPC_RUN = $pref->[0];
+ local $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1];
- my $ok = run( command => "$^X -ledie" );
- ok( !$ok, "Failure caught" );
+ my ($ok,$err) = run( command => "$^X -edie" );
+ ok( !$ok, "Non-zero exit caught" );
+ ok( $err, " Error '$err'" );
}
-}
-
-__END__
-
-
-### check if IPC::Run is already loaded, if so, IPC::Run tests
-### from IPC::Run are known to fail on win32
-my $Skip_IPC_Run = ($^O eq 'MSWin32' && exists $INC{'IPC/Run.pm'}) ? 1 : 0;
-
-use_ok( 'IPC::Cmd' ) or diag "Cmd.pm not found. Dying", die;
-
-IPC::Cmd->import( qw[can_run run] );
-
-### silence it ###
-$IPC::Cmd::VERBOSE = $IPC::Cmd::VERBOSE = $ARGV[0] ? 1 : 0;
-
-{
- ok( can_run('perl'), q[Found 'perl' in your path] );
- ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
-}
-
-
-{ ### list of commands and regexes matching output ###
- my $map = [
- ["$^X -v", qr/larry\s+wall/i, ],
- [[$^X, '-v'], qr/larry\s+wall/i, ],
- ["$^X -eprint1 | $^X -neprint", qr/1/, ],
- [[$^X,qw[-eprint1 |], $^X, qw|-neprint|], qr/1/, ],
- ];
+}
- my @prefs = ( [1,1], [0,1], [0,0] );
-
- ### if IPC::Run is already loaded,remove tests involving IPC::Run
- ### when on win32
- shift @prefs if $Skip_IPC_Run;
-
- for my $pref ( @prefs ) {
- $IPC::Cmd::USE_IPC_RUN = $IPC::Cmd::USE_IPC_RUN = $pref->[0];
- $IPC::Cmd::USE_IPC_OPEN3 = $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1];
-
- for my $aref ( @$map ) {
- my $cmd = $aref->[0];
- my $regex = $aref->[1];
-
- my $Can_Buffer;
- my $captured;
- my $ok = run( command => $cmd,
- buffer => \$captured,
- );
-
- ok($ok, q[Successful run of command] );
-
- SKIP: {
- skip "No buffers returned", 1 unless $captured;
- like( $captured, $regex, q[ Buffer filled] );
-
- ### if we get here, we have buffers ###
- $Can_Buffer++;
- }
-
- my @list = run( command => $cmd );
- ok( $list[0], "Command ran successfully" );
- ok( !$list[1], " No error code set" );
-
- SKIP: {
- skip "No buffers, cannot do buffer tests", 3
- unless $Can_Buffer;
+### timeout tests
+{ my $timeout = 1;
+ for my $pref ( @Prefs ) {
+ diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
+ if $Verbose;
- ok( (grep /$regex/, @{$list[2]}),
- " Out buffer filled" );
- SKIP: {
- skip "IPC::Run bug prevents separated " .
- "stdout/stderr buffers", 2 if $pref->[0];
+ local $IPC::Cmd::USE_IPC_RUN = $pref->[0];
+ local $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1];
- ok( (grep /$regex/, @{$list[3]}),
- " Stdout buffer filled" );
- ok( @{$list[4]} == 0,
- " Stderr buffer empty" );
- }
- }
- }
+ ### -X to quiet the 'sleep without parens is ambiguous' warning
+ my ($ok,$err) = run( command => "$^X -Xesleep+4", timeout => $timeout );
+ ok( !$ok, "Timeout caught" );
+ ok( $err, " Error stored" );
+ ok( not(ref($err)), " Error string is not a reference" );
+ like( $err,qr/^$AClass/," Error '$err' mentions $AClass" );
}
-}
+}
+
projects / p5sagit/p5-mst-13.2.git / blobdiff