1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
#!/usr/bin/perl
=pod
=head1 NAME
adopt.t - Test suite for IPC::Run::adopt
=cut
use strict;
BEGIN {
$| = 1;
$^W = 1;
if( $ENV{PERL_CORE} ) {
chdir '../lib/IPC/Run' if -d '../lib/IPC/Run';
unshift @INC, 'lib', '../..';
$^X = '../../../t/' . $^X;
}
}
use Test::More skip_all => 'adopt not implemented yet';
# use Test::More tests => 29;
use IPC::Run qw( start pump finish );
##
## $^X is the path to the perl binary. This is used run all the subprocesses.
##
my @echoer = ( $^X, '-pe', 'BEGIN { $| = 1 }' );
##
## harness, pump, run
##
SCOPE: {
my $in = 'SHOULD BE UNCHANGED';
my $out = 'REPLACE ME';
$? = 99;
my $fd_map = IPC::Run::_map_fds();
my $h = start( \@echoer, \$in, \$out );
ok( $h->isa('IPC::Run') );
ok( $?, 99 );
ok( $in, 'SHOULD BE UNCHANGED' );
ok( $out, '' );
ok( $h->pumpable );
$in = '';
$? = 0;
pump_nb $h for ( 1..100 );
ok( 1 );
ok( $in, '' );
ok( $out, '' );
ok( $h->pumpable );
}
SCOPE: {
my $in = 'SHOULD BE UNCHANGED';
my $out = 'REPLACE ME';
$? = 99;
my $fd_map = IPC::Run::_map_fds();
my $h = start( \@echoer, \$in, \$out );
ok( $h->isa('IPC::Run') );
ok( $?, 99 );
ok( $in, 'SHOULD BE UNCHANGED' );
ok( $out, '' );
ok( $h->pumpable );
$in = "hello\n";
$? = 0;
pump $h until $out =~ /hello/;
ok( 1 );
ok( ! $? );
ok( $in, '' );
ok( $out, "hello\n" );
ok( $h->pumpable );
$in = "world\n";
$? = 0;
pump $h until $out =~ /world/;
ok( 1 );
ok( ! $? );
ok( $in, '' );
ok( $out, "hello\nworld\n" );
ok( $h->pumpable );
warn "hi";
ok( $h->finish );
ok( ! $? );
ok( IPC::Run::_map_fds(), $fd_map );
ok( $out, "hello\nworld\n" );
ok( ! $h->pumpable );
}
|
