Commit | Line | Data |
378cc40b |
1 | #!./perl |
2 | |
ba553610 |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
378cc40b |
7 | |
1bb0a50f |
8 | use Config; |
9 | |
ba553610 |
10 | my $test = 1; |
31775886 |
11 | print "1..12\n"; |
378cc40b |
12 | print "ok 1\n"; |
13 | |
ba553610 |
14 | open(DUPOUT,">&STDOUT"); |
15 | open(DUPERR,">&STDERR"); |
378cc40b |
16 | |
ba553610 |
17 | open(STDOUT,">Io.dup") || die "Can't open stdout"; |
a687059c |
18 | open(STDERR,">&STDOUT") || die "Can't open stderr"; |
378cc40b |
19 | |
a687059c |
20 | select(STDERR); $| = 1; |
21 | select(STDOUT); $| = 1; |
378cc40b |
22 | |
a687059c |
23 | print STDOUT "ok 2\n"; |
24 | print STDERR "ok 3\n"; |
ba553610 |
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 |
30 | print `$cmd`; |
31 | |
dc459aad |
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 |
34 | print `$cmd`; |
35 | |
36 | # KNOWN BUG system() does not honor STDOUT redirections on VMS. |
37 | if( $^O eq 'VMS' ) { |
31775886 |
38 | print "not ok $_ # TODO system() not honoring STDOUT redirect on VMS\n" |
ba553610 |
39 | for 6..7; |
40 | } |
41 | else { |
42 | system sprintf $echo, 6; |
dc459aad |
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 |
51 | close(STDOUT) or die "Could not close: $!"; |
52 | close(STDERR) or die "Could not close: $!"; |
378cc40b |
53 | |
d1e4d418 |
54 | open(STDOUT,">&DUPOUT") or die "Could not open: $!"; |
55 | open(STDERR,">&DUPERR") or die "Could not open: $!"; |
378cc40b |
56 | |
cda41bc1 |
57 | if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup` } |
dc459aad |
58 | elsif ($^O eq 'MacOS') { system 'catenate Io.dup' } |
59 | else { system 'cat Io.dup' } |
378cc40b |
60 | unlink 'Io.dup'; |
61 | |
e4a4387c |
62 | print STDOUT "ok 8\n"; |
9394203c |
63 | |
1bb0a50f |
64 | open(F,">&",1) or die "Cannot dup to numeric 1: $!"; |
31775886 |
65 | print F "ok 9\n"; |
66 | close(F); |
67 | |
1bb0a50f |
68 | open(F,">&",'1') or die "Cannot dup to string '1': $!"; |
31775886 |
69 | print F "ok 10\n"; |
70 | close(F); |
71 | |
1bb0a50f |
72 | open(F,">&=",1) or die "Cannot dup to numeric 1: $!"; |
31775886 |
73 | print F "ok 11\n"; |
74 | close(F); |
75 | |
1bb0a50f |
76 | if ($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 | |