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