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