xref: /openbsd/gnu/usr.bin/perl/t/io/dup.t (revision a6445c1d) 
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;
13my $tests_needing_perlio = 17;
14plan(12 + $tests_needing_perlio);
15print "ok 1\n";
16
17open(DUPOUT,">&STDOUT");
18open(DUPERR,">&STDERR");
19
20my $tempfile = tempfile();
21
22open(STDOUT,">$tempfile")  || die "Can't open stdout";
23open(STDERR,">&STDOUT") || die "Can't open stderr";
24
25select(STDERR); $| = 1;
26select(STDOUT); $| = 1;
27
28print STDOUT "ok 2\n";
29print STDERR "ok 3\n";
30
31# Since some systems don't have echo, we use Perl.
32$echo = qq{$^X -le "print q(ok %d)"};
33
34$cmd = sprintf $echo, 4;
35print `$cmd`;
36
37$cmd = sprintf "$echo 1>&2", 5;
38print `$cmd`;
39
40system sprintf $echo, 6;
41system sprintf "$echo 1>&2", 7;
42
43close(STDOUT) or die "Could not close: $!";
44close(STDERR) or die "Could not close: $!";
45
46open(STDOUT,">&DUPOUT") or die "Could not open: $!";
47open(STDERR,">&DUPERR") or die "Could not open: $!";
48
49if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) { print `type $tempfile` }
50elsif ($^O eq 'VMS')   { system "type $tempfile.;" } # TYPE defaults to .LIS when there is no extension
51else { system "cat $tempfile" }
52
53print STDOUT "ok 8\n";
54
55open(F,">&",1) or die "Cannot dup to numeric 1: $!";
56print F "ok 9\n";
57close(F);
58
59open(F,">&",'1') or die "Cannot dup to string '1': $!";
60print F "ok 10\n";
61close(F);
62
63open(F,">&=",1) or die "Cannot dup to numeric 1: $!";
64print F "ok 11\n";
65close(F);
66
67if ($Config{useperlio}) {
68    open(F,">&=",'1') or die "Cannot dup to string '1': $!";
69    print F "ok 12\n";
70    close(F);
71} else {
72    open(F, ">&DUPOUT") or die "Cannot dup stdout back: $!";
73    print F "ok 12\n";
74    close(F);
75}
76
77# To get STDOUT back.
78open(F, ">&DUPOUT") or die "Cannot dup stdout back: $!";
79
80curr_test(13);
81
82SKIP: {
83    skip("need perlio", $tests_needing_perlio) unless $Config{useperlio};
84
85    ok(open(F, ">&", STDOUT));
86    isnt(fileno(F), fileno(STDOUT));
87    close F;
88
89    ok(open(F, "<&=STDIN")) or _diag $!;
90    is(fileno(F), fileno(STDIN));
91    close F;
92
93    ok(open(F, ">&=STDOUT"));
94    is(fileno(F), fileno(STDOUT));
95    close F;
96
97    ok(open(F, ">&=STDERR"));
98    is(fileno(F), fileno(STDERR));
99    close F;
100
101    open(G, ">$tempfile") or die;
102    my $g = fileno(G);
103
104    ok(open(F, ">&=$g"));
105    is(fileno(F), $g);
106    close F;
107
108    ok(open(F, ">&=G"));
109    is(fileno(F), $g);
110
111    print G "ggg\n";
112    print F "fff\n";
113
114    close G; # flush first
115    close F; # flush second
116
117    open(G, "<$tempfile") or die;
118    {
119	my $line;
120	$line = <G>; chomp $line; is($line, "ggg");
121	$line = <G>; chomp $line; is($line, "fff");
122    }
123    close G;
124
125    open UTFOUT, '>:utf8', $tempfile or die $!;
126    open UTFDUP, '>&UTFOUT' or die $!;
127    # some old greek saying.
128    my $message = "\x{03A0}\x{0391}\x{039D}\x{03A4}\x{0391} \x{03A1}\x{0395}\x{0399}\n";
129    print UTFOUT $message;
130    print UTFDUP $message;
131    binmode UTFDUP, ':utf8';
132    print UTFDUP $message;
133    close UTFOUT;
134    close UTFDUP;
135    open(UTFIN, "<:utf8", $tempfile) or die $!;
136    {
137	my $line;
138	$line = <UTFIN>; is($line, $message);
139	$line = <UTFIN>; is($line, $message);
140	$line = <UTFIN>; is($line, $message);
141    }
142    close UTFIN;
143
144}
145