home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / open2.t < prev    next >
Text File  |  1999-07-20  |  1KB  |  60 lines
  1. #!./perl -w
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     unshift @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' || $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') {
  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, $?;
  60.