1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = qw(. ../lib);
6    require "./test.pl";
7}
8
9use Config;
10no warnings 'once';
11
12my $test = 1;
13print "1..26\n";
14print "ok 1\n";
15
16open(DUPOUT,">&STDOUT");
17open(DUPERR,">&STDERR");
18
19open(STDOUT,">Io.dup")  || die "Can't open stdout";
20open(STDERR,">&STDOUT") || die "Can't open stderr";
21
22select(STDERR); $| = 1;
23select(STDOUT); $| = 1;
24
25print STDOUT "ok 2\n";
26print STDERR "ok 3\n";
27
28# Since some systems don't have echo, we use Perl.
29$echo = qq{$^X -le "print q(ok %d)"};
30
31$cmd = sprintf $echo, 4;
32print `$cmd`;
33
34$cmd = sprintf "$echo 1>&2", 5;
35$cmd = sprintf $echo, 5 if $^O eq 'MacOS';  # don't know if we can do this ...
36print `$cmd`;
37
38# KNOWN BUG system() does not honor STDOUT redirections on VMS.
39if( $^O eq 'VMS' ) {
40    print "not ok $_ # TODO system() not honoring STDOUT redirect on VMS\n"
41      for 6..7;
42}
43else {
44    system sprintf $echo, 6;
45    if ($^O eq 'MacOS') {
46        system sprintf $echo, 7;
47    }
48    else {
49        system sprintf "$echo 1>&2", 7;
50    }
51}
52
53close(STDOUT) or die "Could not close: $!";
54close(STDERR) or die "Could not close: $!";
55
56open(STDOUT,">&DUPOUT") or die "Could not open: $!";
57open(STDERR,">&DUPERR") or die "Could not open: $!";
58
59if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup` }
60elsif ($^O eq 'MacOS') { system 'catenate Io.dup' }
61else                   { system 'cat Io.dup' }
62unlink 'Io.dup';
63
64print STDOUT "ok 8\n";
65
66open(F,">&",1) or die "Cannot dup to numeric 1: $!";
67print F "ok 9\n";
68close(F);
69
70open(F,">&",'1') or die "Cannot dup to string '1': $!";
71print F "ok 10\n";
72close(F);
73
74open(F,">&=",1) or die "Cannot dup to numeric 1: $!";
75print F "ok 11\n";
76close(F);
77
78if ($Config{useperlio}) {
79    open(F,">&=",'1') or die "Cannot dup to string '1': $!";
80    print F "ok 12\n";
81    close(F);
82} else {
83    open(F, ">&DUPOUT") or die "Cannot dup stdout back: $!";
84    print F "ok 12\n";
85    close(F);
86}
87
88# To get STDOUT back.
89open(F, ">&DUPOUT") or die "Cannot dup stdout back: $!";
90
91curr_test(13);
92
93SKIP: {
94    skip("need perlio", 14) unless $Config{useperlio};
95
96    ok(open(F, ">&", STDOUT));
97    isnt(fileno(F), fileno(STDOUT));
98    close F;
99
100    ok(open(F, "<&=STDIN")) or _diag $!;
101    is(fileno(F), fileno(STDIN));
102    close F;
103
104    ok(open(F, ">&=STDOUT"));
105    is(fileno(F), fileno(STDOUT));
106    close F;
107
108    ok(open(F, ">&=STDERR"));
109    is(fileno(F), fileno(STDERR));
110    close F;
111
112    open(G, ">dup$$") or die;
113    my $g = fileno(G);
114
115    ok(open(F, ">&=$g"));
116    is(fileno(F), $g);
117    close F;
118
119    ok(open(F, ">&=G"));
120    is(fileno(F), $g);
121
122    print G "ggg\n";
123    print F "fff\n";
124
125    close G; # flush first
126    close F; # flush second
127
128    open(G, "<dup$$") or die;
129    {
130	my $line;
131	$line = <G>; chomp $line; is($line, "ggg");
132	$line = <G>; chomp $line; is($line, "fff");
133    }
134    close G;
135
136    END { 1 while unlink "dup$$" }
137}
138