xref: /openbsd-src/gnu/usr.bin/perl/dist/IO/t/io_dup.t (revision 256a93a44f36679bee503f12e49566c2183f6181)
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