This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use $Config{_exe}.
[perl5.git] / t / io / dup.t
CommitLineData
378cc40b
LW
1#!./perl
2
ba553610
MS
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
378cc40b 7
1bb0a50f
JH
8use Config;
9
ba553610 10my $test = 1;
31775886 11print "1..12\n";
378cc40b
LW
12print "ok 1\n";
13
ba553610
MS
14open(DUPOUT,">&STDOUT");
15open(DUPERR,">&STDERR");
378cc40b 16
ba553610 17open(STDOUT,">Io.dup") || die "Can't open stdout";
a687059c 18open(STDERR,">&STDOUT") || die "Can't open stderr";
378cc40b 19
a687059c
LW
20select(STDERR); $| = 1;
21select(STDOUT); $| = 1;
378cc40b 22
a687059c
LW
23print STDOUT "ok 2\n";
24print STDERR "ok 3\n";
ba553610
MS
25
26# Since some systems don't have echo, we use Perl.
dc459aad 27$echo = qq{$^X -le "print q(ok %d)"};
ba553610 28
dc459aad 29$cmd = sprintf $echo, 4;
ba553610
MS
30print `$cmd`;
31
dc459aad
JH
32$cmd = sprintf "$echo 1>&2", 5;
33$cmd = sprintf $echo, 5 if $^O eq 'MacOS'; # don't know if we can do this ...
ba553610
MS
34print `$cmd`;
35
36# KNOWN BUG system() does not honor STDOUT redirections on VMS.
37if( $^O eq 'VMS' ) {
31775886 38 print "not ok $_ # TODO system() not honoring STDOUT redirect on VMS\n"
ba553610
MS
39 for 6..7;
40}
41else {
42 system sprintf $echo, 6;
dc459aad
JH
43 if ($^O eq 'MacOS') {
44 system sprintf $echo, 7;
45 }
46 else {
47 system sprintf "$echo 1>&2", 7;
48 }
ba553610 49}
378cc40b 50
d1e4d418
A
51close(STDOUT) or die "Could not close: $!";
52close(STDERR) or die "Could not close: $!";
378cc40b 53
d1e4d418
A
54open(STDOUT,">&DUPOUT") or die "Could not open: $!";
55open(STDERR,">&DUPERR") or die "Could not open: $!";
378cc40b 56
cda41bc1 57if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup` }
dc459aad
JH
58elsif ($^O eq 'MacOS') { system 'catenate Io.dup' }
59else { system 'cat Io.dup' }
378cc40b
LW
60unlink 'Io.dup';
61
e4a4387c 62print STDOUT "ok 8\n";
9394203c 63
1bb0a50f 64open(F,">&",1) or die "Cannot dup to numeric 1: $!";
31775886
NIS
65print F "ok 9\n";
66close(F);
67
1bb0a50f 68open(F,">&",'1') or die "Cannot dup to string '1': $!";
31775886
NIS
69print F "ok 10\n";
70close(F);
71
1bb0a50f 72open(F,">&=",1) or die "Cannot dup to numeric 1: $!";
31775886
NIS
73print F "ok 11\n";
74close(F);
75
1bb0a50f
JH
76if ($Config{useperlio}) {
77 open(F,">&=",'1') or die "Cannot dup to string '1': $!";
78 print F "ok 12\n";
79 close(F);
80} else {
81 open(F, ">&DUPOUT") or die "Cannot dup stdout back: $!";
82 print F "ok 12\n";
83 close(F);
84}
31775886 85