xref: /openbsd/gnu/usr.bin/perl/dist/IO/t/io_pipe.t (revision 4bdff4be) 
1#!./perl
2
3my $perl;
4
5BEGIN {
6    $perl = $^X;
7}
8
9use Config;
10
11BEGIN {
12    my $can_fork = $Config{d_fork} ||
13		    (($^O eq 'MSWin32' || $^O eq 'NetWare') and
14		     $Config{useithreads} and
15		     $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
16		    );
17    my $reason;
18    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
19	$reason = 'IO extension unavailable';
20    }
21    elsif (!$can_fork) {
22        $reason = 'no fork';
23    }
24    elsif ($^O eq 'MSWin32' && !$ENV{TEST_IO_PIPE}) {
25	$reason = 'Win32 testing environment not set';
26    }
27    if ($reason) {
28	print "1..0 # Skip: $reason\n";
29	exit 0;
30    }
31}
32
33use IO::Pipe;
34
35my $is_win32=$^O eq 'MSWin32' ? "MSWin32 has broken pipes" : "";
36
37$| = 1;
38print "1..10\n";
39
40my $pipe;
41
42if ($is_win32) {
43    print "ok $_ # skipped: $is_win32\n" for 1..4;
44} else {
45    $pipe = IO::Pipe->new()->reader($perl, '-e', 'print qq(not ok 1\n)');
46    while (<$pipe>) {
47      s/^not //;
48      print;
49    }
50    $pipe->close or print "# \$!=$!\nnot ";
51    print "ok 2\n";
52    my $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //';
53    $pipe = IO::Pipe->new()->writer($perl, '-pe', $cmd);
54    print $pipe "not ok 3\n" ;
55    $pipe->close or print "# \$!=$!\nnot ";
56    print "ok 4\n";
57}
58
59# Check if can fork with dynamic extensions (bug in CRT):
60if ($^O eq 'os2' and
61    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
62    print "ok $_ # skipped: broken fork\n" for 5..10;
63    exit 0;
64}
65
66$pipe = IO::Pipe->new();
67
68my $pid = fork();
69
70if($pid)
71 {
72  $pipe->writer;
73  print $pipe "Xk 5\n";
74  print $pipe "oY 6\n";
75  $pipe->close;
76  wait;
77 }
78elsif(defined $pid)
79 {
80  $pipe->reader;
81  my $stdin = bless \*STDIN, "IO::Handle";
82  $stdin->fdopen($pipe,"r");
83  exec $^X, '-pne', 'tr/YX/ko/';
84 }
85else
86 {
87  die "# error = $!";
88 }
89
90if ($is_win32) {
91    print "ok $_ # skipped: $is_win32\n" for 7..8;
92} else {
93    $pipe = IO::Pipe->new();
94    my $pid = fork();
95
96    if($pid)
97 {
98  $pipe->reader;
99  while(<$pipe>) {
100      s/^not //;
101      print;
102  }
103  $pipe->close;
104  wait;
105 }
106    elsif(defined $pid)
107 {
108  $pipe->writer;
109
110  my $stdout = bless \*STDOUT, "IO::Handle";
111  $stdout->fdopen($pipe,"w");
112  print STDOUT "not ok 7\n";
113  my @echo = 'echo';
114  if ( $^O =~ /android/ ) {
115     @echo = ('sh', '-c', q{echo $@}, '--');
116  }
117  exec @echo, 'not ok 8';
118 }
119    else
120 {
121  die;
122 }
123}
124if ($is_win32) {
125    print "ok $_ # skipped: $is_win32\n" for 9;
126} else {
127    $pipe = IO::Pipe->new;
128    $pipe->writer;
129
130    $SIG{'PIPE'} = 'broken_pipe';
131
132    sub broken_pipe {
133    print "ok 9\n";
134    }
135
136    print $pipe "not ok 9\n";
137    $pipe->close;
138
139    sleep 1;
140}
141print "ok 10\n";
142
143