t/io/dup.t

   1 #!./perl
   2
   3 # $RCSfile: dup.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:27 $
   4
   5 print "1..7\n";
   6
   7 print "ok 1\n";
   8
   9 open(dupout,">&STDOUT");
  10 open(duperr,">&STDERR");
  11
  12 open(STDOUT,">Io.dup") || die "Can't open stdout";
  13 open(STDERR,">&STDOUT") || die "Can't open stderr";
  14
  15 select(STDERR); $| = 1;
  16 select(STDOUT); $| = 1;
  17
  18 print STDOUT "ok 2\n";
  19 print STDERR "ok 3\n";
  20 if ($^O eq 'MSWin32') {
  21     print `echo ok 4`;
  22     print `echo ok 5 1>&2`; # does this work?
  23 }
  24 else {
  25     system 'echo ok 4';
  26     system 'echo ok 5 1>&2';
  27 }
  28
  29 close(STDOUT);
  30 close(STDERR);
  31
  32 open(STDOUT,">&dupout");
  33 open(STDERR,">&duperr");
  34
  35 if ($^O eq 'MSWin32') { print `type Io.dup` }
  36 else                  { system 'cat Io.dup' }
  37 unlink 'Io.dup';
  38
  39 print STDOUT "ok 6\n";
  40
  41 # 7  # 19990811 mjd@plover.com
  42 my ($out1, $out2) = ("Line 1\n", "Line 2\n");
  43 open(W, "> Io.dup") || die "Can't open stdout";
  44 print W $out1, $out2;
  45 close W;
  46 open(R1, "< Io.dup") || die "Can't read temp file";
  47 $in1 = <R1>;
  48 open(R2, "<&R1") || die "Can't dup";
  49 $in2 = <R2>;
  50 print "not " unless $in1 eq $out1 && $in2 eq $out2;
  51 print "ok 7\n";
  52
  53 unlink("Io.dup");