This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix typos (spelling errors) in cpan/IPC-Cmd/*.
[perl5.git] / cpan / IPC-Cmd / t / 02_Interactive.t
1 BEGIN { chdir 't' if -d 't'; };
2 BEGIN { use lib '../lib'; };
3
4 use strict;
5 use File::Spec;
6
7 ### only run interactive tests when there's someone that can answer them
8 use Test::More -t STDOUT
9                     ? 'no_plan' 
10                     : ( skip_all => "No interactive tests from harness" );
11
12 my $Class   = 'IPC::Cmd';
13 my $Child   = File::Spec->catfile( qw[src child.pl] );
14 my @FDs     = 0..20;
15 my $IsWin32 = $^O eq 'MSWin32';
16
17 use_ok( $Class, 'run' );
18 $IPC::Cmd::DEBUG = 1;
19
20 my $Have_IPC_Run    = $Class->can_use_ipc_run;
21 my $Have_IPC_Open3  = $Class->can_use_ipc_open3;
22
23 ### configurations to test IPC::Cmd with
24 my @Conf = ( 
25     [ $Have_IPC_Run, $Have_IPC_Open3 ], 
26     [ 0,             $Have_IPC_Open3 ], 
27     [ 0,             0 ] 
28 );
29
30
31
32
33 ### first, check which FD's are open. they should be open
34 ### /after/ we run our tests as well.
35 ### 0, 1 and 2 should be open, as they are STDOUT, STDERR and STDIN
36 ### XXX 2 are opened by Test::Builder at least.. this is 'whitebox'
37 ### knowledge, so unsafe to test against. around line 1322:
38 # sub _open_testhandles {
39 #     return if $Opened_Testhandles;
40 #     # We dup STDOUT and STDERR so people can change them in their
41 #     # test suites while still getting normal test output.
42 #     open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
43 #     open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";
44 #     $Opened_Testhandles = 1;
45 # }
46
47 my @Opened;
48 {   for ( @FDs ) {
49         my $fh;
50         my $rv = open $fh, "<&$_";
51         push @Opened, $_ if $rv;
52     }
53     diag( "Opened FDs: @Opened" );
54     cmp_ok( scalar(@Opened), '>=', 3,
55                                 "At least 3 FDs are opened" );
56 }
57
58 for my $aref ( @Conf ) {
59
60     ### stupid warnings
61     local $IPC::Cmd::USE_IPC_RUN    = $aref->[0];
62     local $IPC::Cmd::USE_IPC_RUN    = $aref->[0];
63
64     local $IPC::Cmd::USE_IPC_OPEN3  = $aref->[1];
65     local $IPC::Cmd::USE_IPC_OPEN3  = $aref->[1];
66
67     diag("Config: IPC::Run = $aref->[0] IPC::Open3 = $aref->[1]");
68     ok( -t STDIN,               "STDIN attached to a tty" );
69     
70     for my $cmd ( qq[$^X $Child], qq[$^X $Child | $^X -neprint] ) {
71     
72         diag("Please enter some input. It will be echo'd back to you");
73         my $buffer;
74         my $ok = run( command => $cmd, verbose => 1, buffer => \$buffer );
75     
76         ok( $ok,                    "   Command '$cmd' ran successfully" );
77     
78         SKIP: {
79             skip "No buffers available", 1 unless $Class->can_capture_buffer;
80             ok( defined $buffer,    "   Input captured" );
81         }
82     }
83 }
84
85 ### check we didnt leak any FHs
86 {   ### should be opened
87     my %open = map { $_ => 1 } @Opened;
88     
89     for ( @FDs ) {
90         my $fh;
91         my $rv = open $fh, "<&=$_";
92      
93         ### these should be open 
94         if( $open{$_} ) {
95             ok( $rv,                "FD $_ opened" );
96             ok( $fh,                "   FH indeed opened" );
97             is( fileno($fh), $_,    "   Opened at the correct fileno($_)" );
98         } else {
99             ok( !$rv,               "FD $_ not opened" );
100             ok( !(fileno($fh)),     "   FH indeed closed" );
101
102             ### extra debug info if tests fail
103 #             use Devel::Peek;
104 #             use Data::Dumper;
105 #             diag( "RV=$rv FH=$fh Fileno=". fileno($fh). Dump($fh) ) if $rv;
106 #             diag( Dumper( [stat $fh] ) )                            if $rv;
107
108         }
109     }
110 }