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
|
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 => 37;
use_ok('PerlIO');
my $txt = "txt$$";
my $bin = "bin$$";
my $utf = "utf$$";
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;
}
# in-memory open
{
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;
}
|
