This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
160700233fe76b5c093413b5ab464576050214ed
[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
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     ### for each configuarion
49     for my $pref ( @Prefs ) {
50         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
51             if $Verbose;
52
53         $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
54         $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
55
56         ### for each command
57         for my $aref ( @$map ) {
58             my $cmd                 = $aref->[0];
59             my $regex               = $aref->[1];
60
61             my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
62             diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") ) 
63                 if $Verbose;
64
65             ### in scalar mode
66             {   diag( "Running scalar mode" ) if $Verbose;
67                 my $buffer;
68                 my $ok = run( command => $cmd, buffer => \$buffer );
69
70                 ok( $ok,        "Ran command succesfully" );
71                 
72                 SKIP: {
73                     skip "No buffers available", 1 
74                                 unless $Class->can_capture_buffer;
75                     
76                     like( $buffer, $regex,  
77                                 "   Buffer filled properly" );
78                 }
79             }
80                 
81             ### in list mode                
82             {   diag( "Running list mode" ) if $Verbose;
83                 my @list = run( command => $cmd );
84                 ok( $list[0],   "Command ran successfully" );
85                 ok( !$list[1],  "   No error code set" );
86
87                 my $list_length = $Class->can_capture_buffer ? 5 : 2;
88                 is( scalar(@list), $list_length,
89                                 "   Output list has $list_length entries" );
90
91                 SKIP: {
92                     skip "No buffers available", 6 
93                                 unless $Class->can_capture_buffer;
94                     
95                     ### the last 3 entries from the RV, are they array refs?
96                     isa_ok( $list[$_], 'ARRAY' ) for 2..4;
97
98                     like( "@{$list[2]}", $regex,
99                                 "   Combined buffer holds output" );
100
101                     like( "@{$list[3]}", qr/$regex/,
102                             "   Stdout buffer filled" );
103                     is( scalar( @{$list[4]} ), 0,
104                                     "   Stderr buffer empty" );
105                 }
106             }
107         }
108     }
109 }
110
111
112 ### test failures
113 {   ### for each configuarion
114     for my $pref ( @Prefs ) {
115         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
116             if $Verbose;
117
118         $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
119         $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
120
121         my $ok = run( command => "$^X -ledie" );
122         ok( !$ok,               "Failure caught" );
123     }
124 }    
125
126 __END__
127
128
129 ### check if IPC::Run is already loaded, if so, IPC::Run tests
130 ### from IPC::Run are known to fail on win32
131 my $Skip_IPC_Run = ($^O eq 'MSWin32' && exists $INC{'IPC/Run.pm'}) ? 1 : 0;
132
133 use_ok( 'IPC::Cmd' ) or diag "Cmd.pm not found.  Dying", die;
134
135 IPC::Cmd->import( qw[can_run run] );
136
137 ### silence it ###
138 $IPC::Cmd::VERBOSE = $IPC::Cmd::VERBOSE = $ARGV[0] ? 1 : 0;
139
140 {
141     ok( can_run('perl'),                q[Found 'perl' in your path] );
142     ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
143 }
144
145
146 {   ### list of commands and regexes matching output ###
147     my $map = [
148         ["$^X -v",                                  qr/larry\s+wall/i, ],
149         [[$^X, '-v'],                               qr/larry\s+wall/i, ],
150         ["$^X -eprint1 | $^X -neprint",             qr/1/,             ],
151         [[$^X,qw[-eprint1 |], $^X, qw|-neprint|],   qr/1/,             ],
152     ];
153
154     my @prefs = ( [1,1], [0,1], [0,0] );
155
156     ### if IPC::Run is already loaded,remove tests involving IPC::Run
157     ### when on win32
158     shift @prefs if $Skip_IPC_Run;
159
160     for my $pref ( @prefs ) {
161         $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
162         $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
163
164         for my $aref ( @$map ) {
165             my $cmd     = $aref->[0];
166             my $regex   = $aref->[1];
167
168             my $Can_Buffer;
169             my $captured;
170             my $ok = run( command => $cmd,
171                           buffer  => \$captured,
172                     );
173
174             ok($ok,     q[Successful run of command] );
175
176             SKIP: {
177                 skip "No buffers returned", 1 unless $captured;
178                 like( $captured, $regex,      q[   Buffer filled] );
179
180                 ### if we get here, we have buffers ###
181                 $Can_Buffer++;
182             }
183
184             my @list = run( command => $cmd );
185             ok( $list[0],       "Command ran successfully" );
186             ok( !$list[1],      "   No error code set" );
187
188             SKIP: {
189                 skip "No buffers, cannot do buffer tests", 3
190                         unless $Can_Buffer;
191
192                 ok( (grep /$regex/, @{$list[2]}),
193                                     "   Out buffer filled" );
194                 SKIP: {
195                     skip "IPC::Run bug prevents separated " .
196                             "stdout/stderr buffers", 2 if $pref->[0];
197
198                     ok( (grep /$regex/, @{$list[3]}),
199                                         "   Stdout buffer filled" );
200                     ok( @{$list[4]} == 0,
201                                         "   Stderr buffer empty" );
202                 }
203             }
204         }
205     }
206 }
207
208