This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[PATCH] Filter-Util-Call (was RE: pmqs: dual life modules)
[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 }
9}
10
51f12e47 11use Test::More tests => 37;
ec28694c 12
51f12e47 13use_ok('PerlIO');
ec28694c
JH
14
15my $txt = "txt$$";
16my $bin = "bin$$";
17my $utf = "utf$$";
18
19my $txtfh;
20my $binfh;
21my $utffh;
22
51f12e47 23ok(open($txtfh, ">:crlf", $txt));
ec28694c 24
51f12e47 25ok(open($binfh, ">:raw", $bin));
ec28694c 26
51f12e47 27ok(open($utffh, ">:utf8", $utf));
ec28694c
JH
28
29print $txtfh "foo\n";
30print $txtfh "bar\n";
51f12e47
JH
31
32ok(close($txtfh));
ec28694c
JH
33
34print $binfh "foo\n";
35print $binfh "bar\n";
51f12e47
JH
36
37ok(close($binfh));
ec28694c
JH
38
39print $utffh "foo\x{ff}\n";
40print $utffh "bar\x{abcd}\n";
ec28694c 41
51f12e47
JH
42ok(close($utffh));
43
44ok(open($txtfh, "<:crlf", $txt));
45
46ok(open($binfh, "<:raw", $bin));
47
48
49ok(open($utffh, "<:utf8", $utf));
ec28694c 50
51f12e47
JH
51is(scalar <$txtfh>, "foo\n");
52is(scalar <$txtfh>, "bar\n");
ec28694c 53
51f12e47
JH
54is(scalar <$binfh>, "foo\n");
55is(scalar <$binfh>, "bar\n");
ec28694c 56
51f12e47
JH
57is(scalar <$utffh>, "foo\x{ff}\n");
58is(scalar <$utffh>, "bar\x{abcd}\n");
ec28694c 59
51f12e47 60ok(eof($txtfh));;
ec28694c 61
51f12e47 62ok(eof($binfh));
ec28694c 63
51f12e47 64ok(eof($utffh));
ec28694c 65
51f12e47 66ok(close($txtfh));
ec28694c 67
51f12e47 68ok(close($binfh));
ec28694c 69
51f12e47 70ok(close($utffh));
ec28694c 71
51f12e47
JH
72# magic temporary file via 3 arg open with undef
73{
74 ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
75 ok( defined fileno($x), ' fileno' );
76
77 select $x;
78 ok( (print "ok\n"), ' print' );
79
80 select STDOUT;
81 ok( seek($x,0,0), ' seek' );
82 is( scalar <$x>, "ok\n", ' readline' );
83 ok( tell($x) >= 3, ' tell' );
84
85 # test magic temp file over STDOUT
86 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
87 my $status = open(STDOUT,"+<",undef);
88 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
89 # report after STDOUT is restored
90 ok($status, ' re-open STDOUT');
91 close OLDOUT;
92}
93
94# in-memory open
0cb48d00
RGS
95SKIP: {
96 eval { require PerlIO::scalar };
97 unless (find PerlIO::Layer 'scalar') {
98 skip("PerlIO::scalar not found", 8);
99 }
51f12e47
JH
100 my $var;
101 ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
102 ok( defined fileno($x), ' fileno' );
103
104 select $x;
105 ok( (print "ok\n"), ' print' );
106
107 select STDOUT;
108 ok( seek($x,0,0), ' seek' );
109 is( scalar <$x>, "ok\n", ' readline' );
110 ok( tell($x) >= 3, ' tell' );
111
112 TODO: {
113 local $TODO = "broken";
114
115 # test in-memory open over STDOUT
116 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
117 #close STDOUT;
118 my $status = open(STDOUT,">",\$var);
119 my $error = "$!" unless $status; # remember the error
3351db02 120 close STDOUT unless $status;
51f12e47
JH
121 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
122 print "# $error\n" unless $status;
123 # report after STDOUT is restored
124 ok($status, ' open STDOUT into in-memory var');
125
126 # test in-memory open over STDERR
127 open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";
128 #close STDERR;
129 ok( open(STDERR,">",\$var), ' open STDERR into in-memory var');
130 open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!";
131 }
132}
ec28694c 133
ec28694c
JH
134
135END {
136 1 while unlink $txt;
137 1 while unlink $bin;
138 1 while unlink $utf;
139}
140