This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a few more distribution versus module name exceptions
[perl5.git] / t / io / perlio.t
1 BEGIN {
2         chdir 't' if -d 't';
3         @INC = '../lib';
4         require Config; import Config;
5         unless (find PerlIO::Layer 'perlio') {
6             print "1..0 # Skip: PerlIO not used\n";
7             exit 0;
8         }
9         require './test.pl';
10 }
11
12 plan tests => 40;
13
14 use_ok('PerlIO');
15
16 my $txt = "txt$$";
17 my $bin = "bin$$";
18 my $utf = "utf$$";
19 my $nonexistent = "nex$$";
20
21 my $txtfh;
22 my $binfh;
23 my $utffh;
24
25 ok(open($txtfh, ">:crlf", $txt));
26
27 ok(open($binfh, ">:raw",  $bin));
28
29 ok(open($utffh, ">:utf8", $utf));
30
31 print $txtfh "foo\n";
32 print $txtfh "bar\n";
33
34 ok(close($txtfh));
35
36 print $binfh "foo\n";
37 print $binfh "bar\n";
38
39 ok(close($binfh));
40
41 print $utffh "foo\x{ff}\n";
42 print $utffh "bar\x{abcd}\n";
43
44 ok(close($utffh));
45
46 ok(open($txtfh, "<:crlf", $txt));
47
48 ok(open($binfh, "<:raw",  $bin));
49
50
51 ok(open($utffh, "<:utf8", $utf));
52
53 is(scalar <$txtfh>, "foo\n");
54 is(scalar <$txtfh>, "bar\n");
55
56 is(scalar <$binfh>, "foo\n");
57 is(scalar <$binfh>, "bar\n");
58
59 is(scalar <$utffh>,  "foo\x{ff}\n");
60 is(scalar <$utffh>, "bar\x{abcd}\n");
61
62 ok(eof($txtfh));;
63
64 ok(eof($binfh));
65
66 ok(eof($utffh));
67
68 ok(close($txtfh));
69
70 ok(close($binfh));
71
72 ok(close($utffh));
73
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;
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;
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');
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     }
105 }
106
107 # in-memory open
108 SKIP: {
109     eval { require PerlIO::scalar };
110     unless (find PerlIO::Layer 'scalar') {
111         skip("PerlIO::scalar not found", 8);
112     }
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
133         close STDOUT unless $status;
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 }
146
147
148 { local $TODO = 'fails well back into 5.8.x';
149
150         
151 sub read_fh_and_return_final_rv {
152         my ($fh) = @_;
153         my $buf = '';
154         my $rv;
155         for (1..3) {
156                 $rv = read($fh, $buf, 1, length($buf));
157                 next if $rv;
158         }
159         return $rv
160 }
161
162 open(my $no_perlio, '<', \'ab') or die; 
163 open(my $perlio, '<:crlf', \'ab') or die; 
164
165 is(read_fh_and_return_final_rv($perlio), read_fh_and_return_final_rv($no_perlio), "RT#69332 - perlio should return the same value as nonperlio after EOF");
166
167 close ($perlio);
168 close ($no_perlio);
169 }
170
171
172 END {
173     1 while unlink $txt;
174     1 while unlink $bin;
175     1 while unlink $utf;
176     rmdir $nonexistent;
177 }
178