Commit | Line | Data |
0d4ddeff |
1 | ## IPC::Cmd test suite ### |
2 | |
3 | BEGIN { chdir 't' if -d 't' }; |
4 | |
5 | use strict; |
6 | use lib qw[../lib]; |
bdd3a62b |
7 | use File::Spec; |
0d4ddeff |
8 | use Test::More 'no_plan'; |
9 | |
bdd3a62b |
10 | my $Class = 'IPC::Cmd'; |
11 | my $AClass = $Class . '::TimeOut'; |
12 | my @Funcs = qw[run can_run QUOTE]; |
13 | my @Meths = qw[can_use_ipc_run can_use_ipc_open3 can_capture_buffer]; |
14 | my $IsWin32 = $^O eq 'MSWin32'; |
15 | my $Verbose = @ARGV ? 1 : 0; |
0d4ddeff |
16 | |
17 | use_ok( $Class, $_ ) for @Funcs; |
18 | can_ok( $Class, $_ ) for @Funcs, @Meths; |
19 | can_ok( __PACKAGE__, $_ ) for @Funcs; |
20 | |
bdd3a62b |
21 | my $Have_IPC_Run = $Class->can_use_ipc_run || 0; |
22 | my $Have_IPC_Open3 = $Class->can_use_ipc_open3 || 0; |
23 | |
24 | diag("IPC::Run: $Have_IPC_Run IPC::Open3: $Have_IPC_Open3"); |
25 | |
26 | local $IPC::Cmd::VERBOSE = $Verbose; |
27 | local $IPC::Cmd::VERBOSE = $Verbose; |
28 | local $IPC::Cmd::DEBUG = $Verbose; |
29 | local $IPC::Cmd::DEBUG = $Verbose; |
0d4ddeff |
30 | |
0d4ddeff |
31 | |
32 | ### run tests in various configurations, based on what modules we have |
bdd3a62b |
33 | my @Prefs = ( ); |
34 | push @Prefs, [ $Have_IPC_Run, $Have_IPC_Open3 ] if $Have_IPC_Run; |
35 | |
36 | ### run this config twice to ensure FD restores work properly |
37 | push @Prefs, [ 0, $Have_IPC_Open3 ], |
38 | [ 0, $Have_IPC_Open3 ] if $Have_IPC_Open3; |
39 | |
40 | ### run this config twice to ensure FD restores work properly |
41 | ### these are the system() tests; |
42 | push @Prefs, [ 0, 0 ], [ 0, 0 ]; |
43 | |
0d4ddeff |
44 | |
45 | ### can_run tests |
46 | { |
47 | ok( can_run('perl'), q[Found 'perl' in your path] ); |
48 | ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] ); |
49 | } |
50 | |
bdd3a62b |
51 | { ### list of commands and regexes matching output |
52 | ### XXX use " everywhere when using literal strings as commands for |
53 | ### portability, especially on win32 |
0d4ddeff |
54 | my $map = [ |
bdd3a62b |
55 | # command # output regex # buffer |
56 | |
57 | ### run tests that print only to stdout |
58 | [ "$^X -v", qr/larry\s+wall/i, 3, ], |
59 | [ [$^X, '-v'], qr/larry\s+wall/i, 3, ], |
60 | |
61 | ### pipes |
62 | [ "$^X -eprint+424 | $^X -neprint+split+2", qr/44/, 3, ], |
63 | [ [$^X,qw[-eprint+424 |], $^X, qw|-neprint+split+2|], |
64 | qr/44/, 3, ], |
65 | ### whitespace |
66 | [ [$^X, '-eprint+shift', q|a b a|], qr/a b a/, 3, ], |
67 | [ qq[$^X -eprint+shift "a b a"], qr/a b a/, 3, ], |
68 | |
69 | ### whitespace + pipe |
70 | [ [$^X, '-eprint+shift', q|a b a|, q[|], $^X, qw[-neprint+split+b] ], |
71 | qr/a a/, 3, ], |
72 | [ qq[$^X -eprint+shift "a b a" | $^X -neprint+split+b], |
73 | qr/a a/, 3, ], |
74 | |
75 | ### run tests that print only to stderr |
76 | [ "$^X -ewarn+42", qr/^42 /, 4, ], |
77 | [ [$^X, '-ewarn+42'], qr/^42 /, 4, ], |
0d4ddeff |
78 | ]; |
79 | |
bdd3a62b |
80 | ### extended test in developer mode |
81 | ### test if gzip | tar works |
82 | if( $Verbose ) { |
83 | my $gzip = can_run('gzip'); |
84 | my $tar = can_run('tar'); |
85 | |
86 | if( $gzip and $tar ) { |
87 | push @$map, |
88 | [ [$gzip, qw[-cdf src/x.tgz |], $tar, qw[-tf -]], |
89 | qr/a/, 3, ]; |
90 | } |
91 | } |
92 | |
0d4ddeff |
93 | ### for each configuarion |
94 | for my $pref ( @Prefs ) { |
0d4ddeff |
95 | |
bdd3a62b |
96 | local $IPC::Cmd::USE_IPC_RUN = !!$pref->[0]; |
97 | local $IPC::Cmd::USE_IPC_RUN = !!$pref->[0]; |
98 | local $IPC::Cmd::USE_IPC_OPEN3 = !!$pref->[1]; |
99 | local $IPC::Cmd::USE_IPC_OPEN3 = !!$pref->[1]; |
0d4ddeff |
100 | |
101 | ### for each command |
102 | for my $aref ( @$map ) { |
bdd3a62b |
103 | my $cmd = $aref->[0]; |
104 | my $regex = $aref->[1]; |
105 | my $index = $aref->[2]; |
0d4ddeff |
106 | |
bdd3a62b |
107 | my $pp_cmd = ref $cmd ? "Array: @$cmd" : "Scalar: $cmd"; |
108 | $pp_cmd .= " (IPC::Run: $pref->[0] IPC::Open3: $pref->[1])"; |
109 | |
110 | diag( "Running '$pp_cmd'") if $Verbose; |
0d4ddeff |
111 | |
112 | ### in scalar mode |
bdd3a62b |
113 | { my $buffer; |
0d4ddeff |
114 | my $ok = run( command => $cmd, buffer => \$buffer ); |
115 | |
bdd3a62b |
116 | ok( $ok, "Ran '$pp_cmd' command succesfully" ); |
0d4ddeff |
117 | |
118 | SKIP: { |
119 | skip "No buffers available", 1 |
120 | unless $Class->can_capture_buffer; |
121 | |
122 | like( $buffer, $regex, |
bdd3a62b |
123 | " Buffer matches $regex -- ($pp_cmd)" ); |
0d4ddeff |
124 | } |
125 | } |
126 | |
127 | ### in list mode |
128 | { diag( "Running list mode" ) if $Verbose; |
129 | my @list = run( command => $cmd ); |
bdd3a62b |
130 | |
131 | ok( $list[0], "Ran '$pp_cmd' successfully" ); |
132 | ok( !$list[1], " No error code set -- ($pp_cmd)" ); |
0d4ddeff |
133 | |
134 | my $list_length = $Class->can_capture_buffer ? 5 : 2; |
135 | is( scalar(@list), $list_length, |
bdd3a62b |
136 | " Output list has $list_length entries -- ($pp_cmd)" ); |
0d4ddeff |
137 | |
138 | SKIP: { |
139 | skip "No buffers available", 6 |
140 | unless $Class->can_capture_buffer; |
141 | |
142 | ### the last 3 entries from the RV, are they array refs? |
143 | isa_ok( $list[$_], 'ARRAY' ) for 2..4; |
144 | |
145 | like( "@{$list[2]}", $regex, |
bdd3a62b |
146 | " Combined buffer matches $regex -- ($pp_cmd)" ); |
0d4ddeff |
147 | |
bdd3a62b |
148 | like( "@{$list[$index]}", qr/$regex/, |
149 | " Proper buffer($index) matches $regex -- ($pp_cmd)" ); |
150 | is( scalar( @{$list[ $index==3 ? 4 : 3 ]} ), 0, |
151 | " Other buffer empty -- ($pp_cmd)" ); |
0d4ddeff |
152 | } |
153 | } |
154 | } |
155 | } |
156 | } |
bdd3a62b |
157 | __END__ |
158 | ### special call to check that output is interleaved properly |
159 | { my $cmd = [$^X, File::Spec->catfile( qw[src output.pl] ) ]; |
0d4ddeff |
160 | |
cce6d045 |
161 | ### for each configuarion |
162 | for my $pref ( @Prefs ) { |
163 | diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" ) |
164 | if $Verbose; |
165 | |
bdd3a62b |
166 | local $IPC::Cmd::USE_IPC_RUN = $pref->[0]; |
167 | local $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1]; |
cce6d045 |
168 | |
bdd3a62b |
169 | my @list = run( command => $cmd, buffer => \my $buffer ); |
170 | ok( $list[0], "Ran @{$cmd} successfully" ); |
171 | ok( !$list[1], " No errorcode set" ); |
172 | SKIP: { |
173 | skip "No buffers available", 3 unless $Class->can_capture_buffer; |
cce6d045 |
174 | |
bdd3a62b |
175 | TODO: { |
176 | local $TODO = qq[Can't interleave input/output buffers yet]; |
cce6d045 |
177 | |
bdd3a62b |
178 | is( "@{$list[2]}",'1 2 3 4'," Combined output as expected" ); |
179 | is( "@{$list[3]}", '1 3', " STDOUT as expected" ); |
180 | is( "@{$list[4]}", '2 4', " STDERR as expected" ); |
181 | |
cce6d045 |
182 | } |
183 | } |
bdd3a62b |
184 | } |
cce6d045 |
185 | } |
0d4ddeff |
186 | |
bdd3a62b |
187 | |
188 | |
0d4ddeff |
189 | ### test failures |
190 | { ### for each configuarion |
191 | for my $pref ( @Prefs ) { |
192 | diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" ) |
193 | if $Verbose; |
194 | |
bdd3a62b |
195 | local $IPC::Cmd::USE_IPC_RUN = $pref->[0]; |
196 | local $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1]; |
0d4ddeff |
197 | |
bdd3a62b |
198 | my ($ok,$err) = run( command => "$^X -edie" ); |
199 | ok( !$ok, "Non-zero exit caught" ); |
200 | ok( $err, " Error '$err'" ); |
0d4ddeff |
201 | } |
bdd3a62b |
202 | } |
0d4ddeff |
203 | |
bdd3a62b |
204 | ### timeout tests |
205 | { my $timeout = 1; |
206 | for my $pref ( @Prefs ) { |
207 | diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" ) |
208 | if $Verbose; |
0d4ddeff |
209 | |
bdd3a62b |
210 | local $IPC::Cmd::USE_IPC_RUN = $pref->[0]; |
211 | local $IPC::Cmd::USE_IPC_OPEN3 = $pref->[1]; |
0d4ddeff |
212 | |
bdd3a62b |
213 | ### -X to quiet the 'sleep without parens is ambiguous' warning |
214 | my ($ok,$err) = run( command => "$^X -Xesleep+4", timeout => $timeout ); |
215 | ok( !$ok, "Timeout caught" ); |
216 | ok( $err, " Error stored" ); |
217 | ok( not(ref($err)), " Error string is not a reference" ); |
218 | like( $err,qr/^$AClass/," Error '$err' mentions $AClass" ); |
0d4ddeff |
219 | } |
bdd3a62b |
220 | } |
221 | |
0d4ddeff |
222 | |
223 | |