1#!./perl -w 2 3use Config; 4BEGIN { 5 require Test::More; 6 if (!$Config{'d_fork'} 7 # open2/3 supported on win32 8 && $^O ne 'MSWin32') 9 { 10 Test::More->import(skip_all => 'open2/3 not available with MSWin32'); 11 exit 0; 12 } 13 # make warnings fatal 14 $SIG{__WARN__} = sub { die @_ }; 15} 16 17use strict; 18use IPC::Open2; 19use Test::More tests => 15; 20 21my $perl = $^X; 22 23sub cmd_line { 24 if ($^O eq 'MSWin32') { 25 return qq/"$_[0]"/; 26 } 27 else { 28 return $_[0]; 29 } 30} 31 32STDOUT->autoflush; 33STDERR->autoflush; 34 35my $pid = open2('READ', 'WRITE', $perl, '-e', cmd_line('print scalar <STDIN>')); 36cmp_ok($pid, '>', 1, 'got a sane process ID'); 37ok(print WRITE "hi kid\n"); 38like(<READ>, qr/^hi kid\r?\n$/); 39ok(close(WRITE), "closing WRITE: $!"); 40ok(close(READ), "closing READ: $!"); 41my $reaped_pid = waitpid $pid, 0; 42is($reaped_pid, $pid, "Reaped PID matches"); 43is($?, 0, '$? should be zero'); 44 45{ 46 package SKREEEK; 47 my $pid = IPC::Open2::open2('KAZOP', 'WRITE', $perl, '-e', 48 main::cmd_line('print scalar <STDIN>')); 49 main::cmp_ok($pid, '>', 1, 'got a sane process ID'); 50 main::ok(print WRITE "hi kid\n"); 51 main::like(<KAZOP>, qr/^hi kid\r?\n$/); 52 main::ok(close(WRITE), "closing WRITE: $!"); 53 main::ok(close(KAZOP), "closing READ: $!"); 54 my $reaped_pid = waitpid $pid, 0; 55 main::is($reaped_pid, $pid, "Reaped PID matches"); 56 main::is($?, 0, '$? should be zero'); 57} 58 59$pid = eval { open2('READ', '', $perl, '-e', cmd_line('print scalar <STDIN>')) }; 60like($@, qr/^open2: Modification of a read-only value attempted at /, 61 'open2 faults read-only parameters correctly') or do {waitpid $pid, 0}; 62