This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update IPC::Cmd to 0.38
[perl5.git] / lib / IPC / Cmd / t / 01_IPC-Cmd.t
1 ## IPC::Cmd test suite ###
2
3 BEGIN { chdir 't' if -d 't' };
4
5 use strict;
6 use lib qw[../lib];
7 use File::Spec ();
8 use Test::More 'no_plan';
9
10 my $Class   = 'IPC::Cmd';
11 my @Funcs   = qw[run can_run];
12 my @Meths   = qw[can_use_ipc_run can_use_ipc_open3 can_capture_buffer];
13 my $IsWin32 = $^O eq 'MSWin32';
14 my $Verbose = @ARGV ? 1 : 0;
15
16 use_ok( $Class,         $_ ) for @Funcs;
17 can_ok( $Class,         $_ ) for @Funcs, @Meths;
18 can_ok( __PACKAGE__,    $_ ) for @Funcs;
19
20 my $Have_IPC_Run    = $Class->can_use_ipc_run;
21 my $Have_IPC_Open3  = $Class->can_use_ipc_open3;
22
23 $IPC::Cmd::VERBOSE  = $IPC::Cmd::VERBOSE = $Verbose;
24
25 ### run tests in various configurations, based on what modules we have
26 my @Prefs = ( 
27     [ $Have_IPC_Run, $Have_IPC_Open3 ], 
28     [ 0,             $Have_IPC_Open3 ], 
29     [ 0,             0 ] 
30 );
31
32 ### can_run tests
33 {
34     ok( can_run('perl'),                q[Found 'perl' in your path] );
35     ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
36 }
37
38 ### run tests that print only to stdout
39 {   ### list of commands and regexes matching output ###
40     my $map = [
41         # command                                    # output regex
42         [ "$^X -v",                                  qr/larry\s+wall/i, ],
43         [ [$^X, '-v'],                               qr/larry\s+wall/i, ],
44         [ "$^X -eprint+42 | $^X -neprint",           qr/42/,            ],
45         [ [$^X,qw[-eprint+42 |], $^X, qw|-neprint|], qr/42/,            ],
46     ];
47
48     diag( "Running tests that print only to stdout" ) if $Verbose;
49     ### for each configuarion
50     for my $pref ( @Prefs ) {
51         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
52             if $Verbose;
53
54         $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
55         $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
56
57         ### for each command
58         for my $aref ( @$map ) {
59             my $cmd                 = $aref->[0];
60             my $regex               = $aref->[1];
61
62             my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
63             diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") ) 
64                 if $Verbose;
65
66             ### in scalar mode
67             {   diag( "Running scalar mode" ) if $Verbose;
68                 my $buffer;
69                 my $ok = run( command => $cmd, buffer => \$buffer );
70
71                 ok( $ok,        "Ran command succesfully" );
72                 
73                 SKIP: {
74                     skip "No buffers available", 1 
75                                 unless $Class->can_capture_buffer;
76                     
77                     like( $buffer, $regex,  
78                                 "   Buffer filled properly" );
79                 }
80             }
81                 
82             ### in list mode                
83             {   diag( "Running list mode" ) if $Verbose;
84                 my @list = run( command => $cmd );
85                 ok( $list[0],   "Command ran successfully" );
86                 ok( !$list[1],  "   No error code set" );
87
88                 my $list_length = $Class->can_capture_buffer ? 5 : 2;
89                 is( scalar(@list), $list_length,
90                                 "   Output list has $list_length entries" );
91
92                 SKIP: {
93                     skip "No buffers available", 6 
94                                 unless $Class->can_capture_buffer;
95                     
96                     ### the last 3 entries from the RV, are they array refs?
97                     isa_ok( $list[$_], 'ARRAY' ) for 2..4;
98
99                     like( "@{$list[2]}", $regex,
100                                 "   Combined buffer holds output" );
101
102                     like( "@{$list[3]}", qr/$regex/,
103                             "   Stdout buffer filled" );
104                     is( scalar( @{$list[4]} ), 0,
105                                     "   Stderr buffer empty" );
106                 }
107             }
108         }
109     }
110 }
111
112 ### run tests that print only to stderr
113 ### XXX lots of duplication from stdout tests, only difference
114 ### is buffer inspection
115 {   ### list of commands and regexes matching output ###
116     my $map = [
117         # command                                    # output regex
118         [ "$^X -ewarn+42",                          qr/^42 /, ],
119         [ [$^X, '-ewarn+42'],                       qr/^42 /, ],
120     ];
121
122     diag( "Running tests that print only to stderr" ) if $Verbose;
123     ### for each configuarion
124     for my $pref ( @Prefs ) {
125         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
126             if $Verbose;
127
128         $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
129         $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
130
131         ### for each command
132         for my $aref ( @$map ) {
133             my $cmd                 = $aref->[0];
134             my $regex               = $aref->[1];
135
136             my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
137             diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") )
138                 if $Verbose;
139
140             ### in scalar mode
141             {   diag( "Running stderr command in scalar mode" ) if $Verbose;
142                 my $buffer;
143                 my $ok = run( command => $cmd, buffer => \$buffer );
144
145                 ok( $ok,        "Ran stderr command succesfully in scalar mode." );
146
147                 SKIP: {
148            # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
149                     skip "No buffers available", 1
150                                 unless $Class->can_capture_buffer;
151
152                     like( $buffer, $regex,
153                                 "   Buffer filled properly from stderr" );
154                 }
155             }
156
157             ### in list mode
158             {   diag( "Running stderr command in list mode" ) if $Verbose;
159                 my @list = run( command => $cmd );
160                 ok( $list[0],   "Ran stderr command successfully in list mode." );
161                 ok( !$list[1],  "   No error code set" );
162
163                 my $list_length = $Class->can_capture_buffer ? 5 : 2;
164                 is( scalar(@list), $list_length,
165                                 "   Output list has $list_length entries" );
166
167                 SKIP: {
168            # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
169                     skip "No buffers available", 6
170                                 unless $Class->can_capture_buffer;
171
172                     ### the last 3 entries from the RV, are they array refs?
173                     isa_ok( $list[$_], 'ARRAY' ) for 2..4;
174
175                     like( "@{$list[2]}", $regex,
176                                 "   Combined buffer holds output" );
177
178                     is( scalar( @{$list[3]} ), 0,
179                                     "   Stdout buffer empty" );
180                     like( "@{$list[4]}", qr/$regex/,
181                             "   Stderr buffer filled" );
182                 }
183             }
184         }
185     }
186 }
187
188 ### test failures
189 {   ### for each configuarion
190     for my $pref ( @Prefs ) {
191         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
192             if $Verbose;
193
194         $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
195         $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
196
197         my $ok = run( command => "$^X -ledie" );
198         ok( !$ok,               "Failure caught" );
199     }
200 }    
201
202 __END__
203
204
205 ### check if IPC::Run is already loaded, if so, IPC::Run tests
206 ### from IPC::Run are known to fail on win32
207 my $Skip_IPC_Run = ($^O eq 'MSWin32' && exists $INC{'IPC/Run.pm'}) ? 1 : 0;
208
209 use_ok( 'IPC::Cmd' ) or diag "Cmd.pm not found.  Dying", die;
210
211 IPC::Cmd->import( qw[can_run run] );
212
213 ### silence it ###
214 $IPC::Cmd::VERBOSE = $IPC::Cmd::VERBOSE = $ARGV[0] ? 1 : 0;
215
216 {
217     ok( can_run('perl'),                q[Found 'perl' in your path] );
218     ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
219 }
220
221
222 {   ### list of commands and regexes matching output ###
223     my $map = [
224         ["$^X -v",                                  qr/larry\s+wall/i, ],
225         [[$^X, '-v'],                               qr/larry\s+wall/i, ],
226         ["$^X -eprint1 | $^X -neprint",             qr/1/,             ],
227         [[$^X,qw[-eprint1 |], $^X, qw|-neprint|],   qr/1/,             ],
228     ];
229
230     my @prefs = ( [1,1], [0,1], [0,0] );
231
232     ### if IPC::Run is already loaded,remove tests involving IPC::Run
233     ### when on win32
234     shift @prefs if $Skip_IPC_Run;
235
236     for my $pref ( @prefs ) {
237         $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
238         $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
239
240         for my $aref ( @$map ) {
241             my $cmd     = $aref->[0];
242             my $regex   = $aref->[1];
243
244             my $Can_Buffer;
245             my $captured;
246             my $ok = run( command => $cmd,
247                           buffer  => \$captured,
248                     );
249
250             ok($ok,     q[Successful run of command] );
251
252             SKIP: {
253                 skip "No buffers returned", 1 unless $captured;
254                 like( $captured, $regex,      q[   Buffer filled] );
255
256                 ### if we get here, we have buffers ###
257                 $Can_Buffer++;
258             }
259
260             my @list = run( command => $cmd );
261             ok( $list[0],       "Command ran successfully" );
262             ok( !$list[1],      "   No error code set" );
263
264             SKIP: {
265                 skip "No buffers, cannot do buffer tests", 3
266                         unless $Can_Buffer;
267
268                 ok( (grep /$regex/, @{$list[2]}),
269                                     "   Out buffer filled" );
270                 SKIP: {
271                     skip "IPC::Run bug prevents separated " .
272                             "stdout/stderr buffers", 2 if $pref->[0];
273
274                     ok( (grep /$regex/, @{$list[3]}),
275                                         "   Stdout buffer filled" );
276                     ok( @{$list[4]} == 0,
277                                         "   Stderr buffer empty" );
278                 }
279             }
280         }
281     }
282 }
283
284