| Line | |
|---|
| 1 | #!./perl -w
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | chdir 't' if -d 't';
|
|---|
| 5 | @INC = '../lib';
|
|---|
| 6 | require Config; import Config;
|
|---|
| 7 | if (!$Config{'d_fork'}
|
|---|
| 8 | # open2/3 supported on win32 (but not Borland due to CRT bugs)
|
|---|
| 9 | && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
|
|---|
| 10 | {
|
|---|
| 11 | print "1..0\n";
|
|---|
| 12 | exit 0;
|
|---|
| 13 | }
|
|---|
| 14 | # make warnings fatal
|
|---|
| 15 | $SIG{__WARN__} = sub { die @_ };
|
|---|
| 16 | }
|
|---|
| 17 |
|
|---|
| 18 | use strict;
|
|---|
| 19 | use IO::Handle;
|
|---|
| 20 | use IPC::Open2;
|
|---|
| 21 | #require 'open2.pl'; use subs 'open2';
|
|---|
| 22 |
|
|---|
| 23 | my $perl = './perl';
|
|---|
| 24 |
|
|---|
| 25 | sub ok {
|
|---|
| 26 | my ($n, $result, $info) = @_;
|
|---|
| 27 | if ($result) {
|
|---|
| 28 | print "ok $n\n";
|
|---|
| 29 | }
|
|---|
| 30 | else {
|
|---|
| 31 | print "not ok $n\n";
|
|---|
| 32 | print "# $info\n" if $info;
|
|---|
| 33 | }
|
|---|
| 34 | }
|
|---|
| 35 |
|
|---|
| 36 | sub cmd_line {
|
|---|
| 37 | if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
|
|---|
| 38 | return qq/"$_[0]"/;
|
|---|
| 39 | }
|
|---|
| 40 | else {
|
|---|
| 41 | return $_[0];
|
|---|
| 42 | }
|
|---|
| 43 | }
|
|---|
| 44 |
|
|---|
| 45 | my ($pid, $reaped_pid);
|
|---|
| 46 | STDOUT->autoflush;
|
|---|
| 47 | STDERR->autoflush;
|
|---|
| 48 |
|
|---|
| 49 | print "1..7\n";
|
|---|
| 50 |
|
|---|
| 51 | ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e',
|
|---|
| 52 | cmd_line('print scalar <STDIN>');
|
|---|
| 53 | ok 2, print WRITE "hi kid\n";
|
|---|
| 54 | ok 3, <READ> =~ /^hi kid\r?\n$/;
|
|---|
| 55 | ok 4, close(WRITE), $!;
|
|---|
| 56 | ok 5, close(READ), $!;
|
|---|
| 57 | $reaped_pid = waitpid $pid, 0;
|
|---|
| 58 | ok 6, $reaped_pid == $pid, $reaped_pid;
|
|---|
| 59 | ok 7, $? == 0, $?;
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.