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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
#!/usr/bin/perl
=pod
=head1 NAME
harness.t - Test suite for IPC::Run::harness
=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 tests => 120;
use IPC::Run qw( harness );
my $f;
sub expand_test {
my ( $args, $expected ) = @_;
my $h;
my @out;
my $i = 0;
SCOPE: {
$h = IPC::Run::harness( @$args );
@out = @{$h->{KIDS}->[0]->{OPS}};
is(
scalar( @out ),
scalar( @$expected ),
join( ' ', @$args )
)
}
foreach my $h ( @$expected ) {
my $j = $i++;
foreach ( sort keys %$h ) {
my ( $key, $value ) = ( $_, $h->{$_} );
my $got = $out[$j]->{$key};
$got = @$got if ref $got eq 'ARRAY';
$got = '<undef>' unless defined $got;
is( $got, $value, join( ' ', @$args ) . ": $j, $key" )
}
}
}
expand_test(
[ ['a'], qw( <b < c 0<d 0< e 1<f 1< g) ],
[
{ TYPE => '<', SOURCE => 'b', KFD => 0, },
{ TYPE => '<', SOURCE => 'c', KFD => 0, },
{ TYPE => '<', SOURCE => 'd', KFD => 0, },
{ TYPE => '<', SOURCE => 'e', KFD => 0, },
{ TYPE => '<', SOURCE => 'f', KFD => 1, },
{ TYPE => '<', SOURCE => 'g', KFD => 1, },
]
);
expand_test(
[ ['a'], qw( >b > c 2>d 2> e >>f >> g 2>>h 2>> i) ],
[
{ TYPE => '>', DEST => 'b', KFD => 1, TRUNC => 1, },
{ TYPE => '>', DEST => 'c', KFD => 1, TRUNC => 1, },
{ TYPE => '>', DEST => 'd', KFD => 2, TRUNC => 1, },
{ TYPE => '>', DEST => 'e', KFD => 2, TRUNC => 1, },
{ TYPE => '>', DEST => 'f', KFD => 1, TRUNC => '', },
{ TYPE => '>', DEST => 'g', KFD => 1, TRUNC => '', },
{ TYPE => '>', DEST => 'h', KFD => 2, TRUNC => '', },
{ TYPE => '>', DEST => 'i', KFD => 2, TRUNC => '', },
]
);
expand_test(
[ ['a'], qw( >&b >& c &>d &> e ) ],
[
{ TYPE => '>', DEST => 'b', KFD => 1, TRUNC => 1, },
{ TYPE => 'dup', KFD1 => 1, KFD2 => 2 },
{ TYPE => '>', DEST => 'c', KFD => 1, TRUNC => 1, },
{ TYPE => 'dup', KFD1 => 1, KFD2 => 2 },
{ TYPE => '>', DEST => 'd', KFD => 1, TRUNC => 1, },
{ TYPE => 'dup', KFD1 => 1, KFD2 => 2 },
{ TYPE => '>', DEST => 'e', KFD => 1, TRUNC => 1, },
{ TYPE => 'dup', KFD1 => 1, KFD2 => 2 },
]
);
expand_test(
[ ['a'],
'>&', sub{}, sub{}, \$f,
'>', sub{}, sub{}, \$f,
'<', sub{}, sub{}, \$f,
],
[
{ TYPE => '>', DEST => \$f, KFD => 1, TRUNC => 1,
FILTERS => 2 },
{ TYPE => 'dup', KFD1 => 1, KFD2 => 2 },
{ TYPE => '>', DEST => \$f, KFD => 1, TRUNC => 1,
FILTERS => 2 },
{ TYPE => '<', SOURCE => \$f, KFD => 0,
FILTERS => 3 },
]
);
expand_test(
[ ['a'], '<', \$f, '>', \$f ],
[
{ TYPE => '<', SOURCE => \$f, KFD => 0, },
{ TYPE => '>', DEST => \$f, KFD => 1, },
]
);
expand_test(
[ ['a'], '<pipe', \$f, '>pipe', \$f ],
[
{ TYPE => '<pipe', SOURCE => \$f, KFD => 0, },
{ TYPE => '>pipe', DEST => \$f, KFD => 1, },
]
);
expand_test(
[ ['a'], '<pipe', \$f, '>', \$f ],
[
{ TYPE => '<pipe', SOURCE => \$f, KFD => 0, },
{ TYPE => '>', DEST => \$f, KFD => 1, },
]
);
|
