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