This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #69686] Fix DragonFly thread lib selection
[perl5.git] / t / io / perlio.t
CommitLineData
ec28694c
JH
1BEGIN {
2 chdir 't' if -d 't';
3 @INC = '../lib';
4 require Config; import Config;
6b5da1a3 5 unless (find PerlIO::Layer 'perlio') {
dc87d25e 6 print "1..0 # Skip: PerlIO not used\n";
ec28694c
JH
7 exit 0;
8 }
0214bff6 9 require './test.pl';
ec28694c
JH
10}
11
0214bff6 12plan tests => 39;
ec28694c 13
51f12e47 14use_ok('PerlIO');
ec28694c
JH
15
16my $txt = "txt$$";
17my $bin = "bin$$";
18my $utf = "utf$$";
26e8050a 19my $nonexistent = "nex$$";
ec28694c
JH
20
21my $txtfh;
22my $binfh;
23my $utffh;
24
51f12e47 25ok(open($txtfh, ">:crlf", $txt));
ec28694c 26
51f12e47 27ok(open($binfh, ">:raw", $bin));
ec28694c 28
51f12e47 29ok(open($utffh, ">:utf8", $utf));
ec28694c
JH
30
31print $txtfh "foo\n";
32print $txtfh "bar\n";
51f12e47
JH
33
34ok(close($txtfh));
ec28694c
JH
35
36print $binfh "foo\n";
37print $binfh "bar\n";
51f12e47
JH
38
39ok(close($binfh));
ec28694c
JH
40
41print $utffh "foo\x{ff}\n";
42print $utffh "bar\x{abcd}\n";
ec28694c 43
51f12e47
JH
44ok(close($utffh));
45
46ok(open($txtfh, "<:crlf", $txt));
47
48ok(open($binfh, "<:raw", $bin));
49
50
51ok(open($utffh, "<:utf8", $utf));
ec28694c 52
51f12e47
JH
53is(scalar <$txtfh>, "foo\n");
54is(scalar <$txtfh>, "bar\n");
ec28694c 55
51f12e47
JH
56is(scalar <$binfh>, "foo\n");
57is(scalar <$binfh>, "bar\n");
ec28694c 58
51f12e47
JH
59is(scalar <$utffh>, "foo\x{ff}\n");
60is(scalar <$utffh>, "bar\x{abcd}\n");
ec28694c 61
51f12e47 62ok(eof($txtfh));;
ec28694c 63
51f12e47 64ok(eof($binfh));
ec28694c 65
51f12e47 66ok(eof($utffh));
ec28694c 67
51f12e47 68ok(close($txtfh));
ec28694c 69
51f12e47 70ok(close($binfh));
ec28694c 71
51f12e47 72ok(close($utffh));
ec28694c 73
51f12e47
JH
74# magic temporary file via 3 arg open with undef
75{
76 ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
77 ok( defined fileno($x), ' fileno' );
78
79 select $x;
80 ok( (print "ok\n"), ' print' );
81
82 select STDOUT;
83 ok( seek($x,0,0), ' seek' );
84 is( scalar <$x>, "ok\n", ' readline' );
85 ok( tell($x) >= 3, ' tell' );
86
87 # test magic temp file over STDOUT
88 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
89 my $status = open(STDOUT,"+<",undef);
90 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
91 # report after STDOUT is restored
92 ok($status, ' re-open STDOUT');
93 close OLDOUT;
26e8050a
NT
94
95 SKIP: {
96 skip("TMPDIR not honored on this platform", 2)
97 if !$Config{d_mkstemp}
98 || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2';
99 local $ENV{TMPDIR} = $nonexistent;
0b99e986 100 ok( open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to a non-existent dir');
26e8050a
NT
101
102 mkdir $ENV{TMPDIR};
103 ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir');
104 }
51f12e47
JH
105}
106
107# in-memory open
0cb48d00
RGS
108SKIP: {
109 eval { require PerlIO::scalar };
110 unless (find PerlIO::Layer 'scalar') {
111 skip("PerlIO::scalar not found", 8);
112 }
51f12e47
JH
113 my $var;
114 ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
115 ok( defined fileno($x), ' fileno' );
116
117 select $x;
118 ok( (print "ok\n"), ' print' );
119
120 select STDOUT;
121 ok( seek($x,0,0), ' seek' );
122 is( scalar <$x>, "ok\n", ' readline' );
123 ok( tell($x) >= 3, ' tell' );
124
125 TODO: {
126 local $TODO = "broken";
127
128 # test in-memory open over STDOUT
129 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
130 #close STDOUT;
131 my $status = open(STDOUT,">",\$var);
132 my $error = "$!" unless $status; # remember the error
3351db02 133 close STDOUT unless $status;
51f12e47
JH
134 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
135 print "# $error\n" unless $status;
136 # report after STDOUT is restored
137 ok($status, ' open STDOUT into in-memory var');
138
139 # test in-memory open over STDERR
140 open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";
141 #close STDERR;
142 ok( open(STDERR,">",\$var), ' open STDERR into in-memory var');
143 open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!";
144 }
145}
ec28694c 146
ec28694c
JH
147
148END {
149 1 while unlink $txt;
150 1 while unlink $bin;
151 1 while unlink $utf;
0b99e986 152 rmdir $nonexistent;
ec28694c
JH
153}
154