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