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