15 open(DUPOUT,">&STDOUT");
16 open(DUPERR,">&STDERR");
18 open(STDOUT,">Io.dup") || die "Can't open stdout";
19 open(STDERR,">&STDOUT") || die "Can't open stderr";
21 select(STDERR); $| = 1;
22 select(STDOUT); $| = 1;
24 print STDOUT "ok 2\n";
25 print STDERR "ok 3\n";
27 # Since some systems don't have echo, we use Perl.
28 $echo = qq{$^X -le "print q(ok %d)"};
30 $cmd = sprintf $echo, 4;
33 $cmd = sprintf "$echo 1>&2", 5;
34 $cmd = sprintf $echo, 5 if $^O eq 'MacOS'; # don't know if we can do this ...
37 # KNOWN BUG system() does not honor STDOUT redirections on VMS.
39 print "not ok $_ # TODO system() not honoring STDOUT redirect on VMS\n"
43 system sprintf $echo, 6;
45 system sprintf $echo, 7;
48 system sprintf "$echo 1>&2", 7;
52 close(STDOUT) or die "Could not close: $!";
53 close(STDERR) or die "Could not close: $!";
55 open(STDOUT,">&DUPOUT") or die "Could not open: $!";
56 open(STDERR,">&DUPERR") or die "Could not open: $!";
58 if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup` }
59 elsif ($^O eq 'MacOS') { system 'catenate Io.dup' }
60 else { system 'cat Io.dup' }
63 print STDOUT "ok 8\n";
65 open(F,">&",1) or die "Cannot dup to numeric 1: $!";
69 open(F,">&",'1') or die "Cannot dup to string '1': $!";
73 open(F,">&=",1) or die "Cannot dup to numeric 1: $!";
77 if ($Config{useperlio}) {
78 open(F,">&=",'1') or die "Cannot dup to string '1': $!";
82 open(F, ">&DUPOUT") or die "Cannot dup stdout back: $!";
88 open(F, ">&DUPOUT") or die "Cannot dup stdout back: $!";
93 skip("need perlio", 14) unless $Config{useperlio};
95 ok(open(F, ">&", STDOUT));
96 isnt(fileno(F), fileno(STDOUT));
99 ok(open(F, "<&=STDIN"));
100 is(fileno(F), fileno(STDIN));
103 ok(open(F, ">&=STDOUT"));
104 is(fileno(F), fileno(STDOUT));
107 ok(open(F, ">&=STDERR"));
108 is(fileno(F), fileno(STDERR));
111 open(G, ">dup$$") or die;
114 ok(open(F, ">&=$g"));
124 close G; # flush first
125 close F; # flush second
127 open(G, "<dup$$") or die;
130 $line = <G>; chomp $line; is($line, "ggg");
131 $line = <G>; chomp $line; is($line, "fff");
135 END { 1 while unlink "dup$$" }