1#!/usr/bin/perl
2
3=pod
4
5=head1 NAME
6
7harness.t - Test suite for IPC::Run::harness
8
9=cut
10
11use strict;
12
13BEGIN {
14    $|  = 1;
15    $^W = 1;
16    if ( $ENV{PERL_CORE} ) {
17        chdir '../lib/IPC/Run' if -d '../lib/IPC/Run';
18        unshift @INC, 'lib', '../..';
19        $^X = '../../../t/' . $^X;
20    }
21}
22
23use Test::More tests => 120;
24use IPC::Run qw( harness );
25
26my $f;
27
28sub expand_test {
29    my ( $args, $expected ) = @_;
30    my $h;
31    my @out;
32    my $i = 0;
33  SCOPE: {
34        $h   = IPC::Run::harness(@$args);
35        @out = @{ $h->{KIDS}->[0]->{OPS} };
36        is(
37            scalar(@out),
38            scalar(@$expected),
39            join( ' ', @$args )
40        );
41    }
42
43    foreach my $h (@$expected) {
44        my $j = $i++;
45        foreach ( sort keys %$h ) {
46            my ( $key, $value ) = ( $_, $h->{$_} );
47            my $got = $out[$j]->{$key};
48            $got = @$got if ref $got eq 'ARRAY';
49            $got = '<undef>' unless defined $got;
50            is( $got, $value, join( ' ', @$args ) . ": $j, $key" );
51        }
52    }
53}
54
55expand_test(
56    [ ['a'], qw( <b < c 0<d 0< e 1<f 1< g) ],
57    [
58        { TYPE => '<', SOURCE => 'b', KFD => 0, },
59        { TYPE => '<', SOURCE => 'c', KFD => 0, },
60        { TYPE => '<', SOURCE => 'd', KFD => 0, },
61        { TYPE => '<', SOURCE => 'e', KFD => 0, },
62        { TYPE => '<', SOURCE => 'f', KFD => 1, },
63        { TYPE => '<', SOURCE => 'g', KFD => 1, },
64    ]
65);
66
67expand_test(
68    [ ['a'], qw( >b > c 2>d 2> e >>f >> g 2>>h 2>> i) ],
69    [
70        { TYPE => '>', DEST => 'b', KFD => 1, TRUNC => 1, },
71        { TYPE => '>', DEST => 'c', KFD => 1, TRUNC => 1, },
72        { TYPE => '>', DEST => 'd', KFD => 2, TRUNC => 1, },
73        { TYPE => '>', DEST => 'e', KFD => 2, TRUNC => 1, },
74        { TYPE => '>', DEST => 'f', KFD => 1, TRUNC => '', },
75        { TYPE => '>', DEST => 'g', KFD => 1, TRUNC => '', },
76        { TYPE => '>', DEST => 'h', KFD => 2, TRUNC => '', },
77        { TYPE => '>', DEST => 'i', KFD => 2, TRUNC => '', },
78    ]
79);
80
81expand_test(
82    [ ['a'], qw( >&b >& c &>d &> e ) ],
83    [
84        { TYPE => '>', DEST => 'b', KFD => 1, TRUNC => 1, },
85        { TYPE => 'dup', KFD1 => 1,   KFD2 => 2 },
86        { TYPE => '>',   DEST => 'c', KFD  => 1, TRUNC => 1, },
87        { TYPE => 'dup', KFD1 => 1,   KFD2 => 2 },
88        { TYPE => '>',   DEST => 'd', KFD  => 1, TRUNC => 1, },
89        { TYPE => 'dup', KFD1 => 1,   KFD2 => 2 },
90        { TYPE => '>',   DEST => 'e', KFD  => 1, TRUNC => 1, },
91        { TYPE => 'dup', KFD1 => 1,   KFD2 => 2 },
92    ]
93);
94
95expand_test(
96    [
97        ['a'],
98        '>&', sub { }, sub { }, \$f,
99        '>',  sub { }, sub { }, \$f,
100        '<',  sub { }, sub { }, \$f,
101    ],
102    [
103        {
104            TYPE    => '>', DEST => \$f, KFD => 1, TRUNC => 1,
105            FILTERS => 2
106        },
107        { TYPE => 'dup', KFD1 => 1, KFD2 => 2 },
108        {
109            TYPE    => '>', DEST => \$f, KFD => 1, TRUNC => 1,
110            FILTERS => 2
111        },
112        {
113            TYPE    => '<', SOURCE => \$f, KFD => 0,
114            FILTERS => 3
115        },
116    ]
117);
118
119expand_test(
120    [ ['a'], '<', \$f, '>', \$f ],
121    [
122        { TYPE => '<', SOURCE => \$f, KFD => 0, },
123        { TYPE => '>', DEST   => \$f, KFD => 1, },
124    ]
125);
126
127expand_test(
128    [ ['a'], '<pipe', \$f, '>pipe', \$f ],
129    [
130        { TYPE => '<pipe', SOURCE => \$f, KFD => 0, },
131        { TYPE => '>pipe', DEST   => \$f, KFD => 1, },
132    ]
133);
134
135expand_test(
136    [ ['a'], '<pipe', \$f, '>', \$f ],
137    [
138        { TYPE => '<pipe', SOURCE => \$f, KFD => 0, },
139        { TYPE => '>',     DEST   => \$f, KFD => 1, },
140    ]
141);
142