1b39c5158Smillert#!./perl 2b39c5158Smillert 3b39c5158Smillertuse Config; 4b39c5158Smillert 5b39c5158SmillertBEGIN { 6b39c5158Smillert if($ENV{PERL_CORE}) { 7b39c5158Smillert if ($Config{'extensions'} !~ /\bIO\b/) { 8b39c5158Smillert print "1..0 # Skip: IO extension not compiled\n"; 9b39c5158Smillert exit 0; 10b39c5158Smillert } 11b39c5158Smillert } 12b39c5158Smillert} 13b39c5158Smillert 14b39c5158Smillertuse IO::Handle; 15b39c5158Smillertuse IO::File; 16b39c5158Smillert 17b39c5158Smillertselect(STDERR); $| = 1; 18b39c5158Smillertselect(STDOUT); $| = 1; 19b39c5158Smillert 20b39c5158Smillertprint "1..6\n"; 21b39c5158Smillert 22b39c5158Smillertprint "ok 1\n"; 23b39c5158Smillert 24*256a93a4Safresh1my $dupout = IO::Handle->new->fdopen( \*STDOUT ,"w"); 25*256a93a4Safresh1my $duperr = IO::Handle->new->fdopen( \*STDERR ,"w"); 26b39c5158Smillert 27*256a93a4Safresh1my $stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle"; 28*256a93a4Safresh1my $stderr = \*STDERR; bless $stderr, "IO::Handle"; 29b39c5158Smillert 30b39c5158Smillert$stdout->open( "Io.dup","w") || die "Can't open stdout"; 31b39c5158Smillert$stderr->fdopen($stdout,"w"); 32b39c5158Smillert 33b39c5158Smillertprint $stdout "ok 2\n"; 34b39c5158Smillertprint $stderr "ok 3\n"; 35b39c5158Smillert 36b39c5158Smillert# Since some systems don't have echo, we use Perl. 37*256a93a4Safresh1my $echo = qq{$^X -le "print q(ok %d)"}; 38b39c5158Smillert 39*256a93a4Safresh1my $cmd = sprintf $echo, 4; 40b39c5158Smillertprint `$cmd`; 41b39c5158Smillert 42b39c5158Smillert$cmd = sprintf "$echo 1>&2", 5; 43b39c5158Smillert$cmd = sprintf $echo, 5 if $^O eq 'MacOS'; 44b39c5158Smillertprint `$cmd`; 45b39c5158Smillert 46b39c5158Smillert$stderr->close; 47b39c5158Smillert$stdout->close; 48b39c5158Smillert 49b39c5158Smillert$stdout->fdopen($dupout,"w"); 50b39c5158Smillert$stderr->fdopen($duperr,"w"); 51b39c5158Smillert 52b39c5158Smillertif ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { print `type Io.dup` } 53b39c5158Smillertelsif ($^O eq 'MacOS') { system 'Catenate Io.dup' } 54b39c5158Smillertelse { system 'cat Io.dup' } 55b39c5158Smillertunlink 'Io.dup'; 56b39c5158Smillert 57b39c5158Smillertprint STDOUT "ok 6\n"; 58