4 require Config; import Config;
6 skip_all_without_perlio();
16 my $nonexistent = "nex$$";
22 ok(open($txtfh, ">:crlf", $txt));
24 ok(open($binfh, ">:raw", $bin));
26 ok(open($utffh, ">:utf8", $utf));
38 print $utffh "foo\x{ff}\n";
39 print $utffh "bar\x{abcd}\n";
43 ok(open($txtfh, "<:crlf", $txt));
45 ok(open($binfh, "<:raw", $bin));
48 ok(open($utffh, "<:utf8", $utf));
50 is(scalar <$txtfh>, "foo\n");
51 is(scalar <$txtfh>, "bar\n");
53 is(scalar <$binfh>, "foo\n");
54 is(scalar <$binfh>, "bar\n");
56 is(scalar <$utffh>, "foo\x{ff}\n");
57 is(scalar <$utffh>, "bar\x{abcd}\n");
71 # magic temporary file via 3 arg open with undef
73 ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
74 ok( defined fileno($x), ' fileno' );
77 ok( (print "ok\n"), ' print' );
80 ok( seek($x,0,0), ' seek' );
81 is( scalar <$x>, "ok\n", ' readline' );
82 ok( tell($x) >= 3, ' tell' );
84 # test magic temp file over STDOUT
85 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
86 my $status = open(STDOUT,"+<",undef);
87 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
88 # report after STDOUT is restored
89 ok($status, ' re-open STDOUT');
93 skip("TMPDIR not honored on this platform", 4)
94 if !$Config{d_mkstemp}
95 || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2';
96 local $ENV{TMPDIR} = $nonexistent;
98 # hardcoded default temp path
99 my $perlio_tmp_file_glob = '/tmp/PerlIO_??????';
101 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');
103 my $filename = find_filename($x, $perlio_tmp_file_glob);
104 is($filename, undef, "No tmp files leaked");
105 unlink_all $filename if defined $filename;
108 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');
110 $filename = find_filename($x, $perlio_tmp_file_glob);
111 is($filename, undef, "No tmp files leaked");
112 unlink_all $filename if defined $filename;
116 # fileno() for directory handles, on supported platforms
119 or die "Huh? Can't open directory 'io' containing this file: $!\n";
124 or die "Huh? Can't close freshly-opened directory handle: $!\n";
125 if ($Config{d_dirfd} || $Config{d_dir_dd_fd}) {
126 ok(defined $fd, "fileno(DIRHANDLE) is defined under dirfd()")
127 or skip("directory fd was undefined", 1);
128 like($fd, qr/\A\d+\z/a,
129 "fileno(DIRHANDLE) yields non-negative int under dirfd()");
132 ok(!defined $fd, "fileno(DIRHANDLE) is undef when no dirfd()");
133 isnt($errno, 0, "fileno(DIRHANDLE) sets errno when no dirfd()");
138 my ($fh, @globs) = @_;
139 my ($dev, $inode) = stat $fh;
140 die "Can't stat $fh: $!" unless defined $dev;
143 foreach my $file (glob $_) {
144 my ($this_dev, $this_inode) = stat $file;
145 next unless defined $this_dev;
146 return $file if $this_dev == $dev && $this_inode == $inode;
154 eval { require PerlIO::scalar };
155 unless (find PerlIO::Layer 'scalar') {
156 skip("PerlIO::scalar not found", 11);
159 ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
160 ok( defined fileno($x), ' fileno' );
163 ok( (print "ok\n"), ' print' );
166 ok( seek($x,0,0), ' seek' );
167 is( scalar <$x>, "ok\n", ' readline' );
168 ok( tell($x) >= 3, ' tell' );
171 local $TODO = "broken";
173 # test in-memory open over STDOUT
174 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
176 my $status = open(STDOUT,">",\$var);
177 my $error = "$!" unless $status; # remember the error
178 close STDOUT unless $status;
179 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
180 print "# $error\n" unless $status;
181 # report after STDOUT is restored
182 ok($status, ' open STDOUT into in-memory var');
184 # test in-memory open over STDERR
185 open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";
187 ok( open(STDERR,">",\$var), ' open STDERR into in-memory var');
188 open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!";
192 { local $TODO = 'fails well back into 5.8.x';
195 sub read_fh_and_return_final_rv {
200 $rv = read($fh, $buf, 1, length($buf));
206 open(my $no_perlio, '<', \'ab') or die;
207 open(my $perlio, '<:crlf', \'ab') or die;
209 is(read_fh_and_return_final_rv($perlio),
210 read_fh_and_return_final_rv($no_perlio),
211 "RT#69332 - perlio should return the same value as nonperlio after EOF");
218 open my $fh, "<", \(my $f = *f);
219 is join("", <$fh>), '*main::f', 'reading from a glob copy';
220 is ref \$f, 'GLOB', 'the glob copy is unaffected';
226 # see RT #75722, RT #96008
227 fresh_perl_like(<<'EOP',
229 return undef unless caller eq "main";
230 open my $fh, "<", \1;
233 require Symbol; # doesn't matter whether it exists or not
235 qr/\ARecursive call to Perl_load_module in PerlIO_find_layer at/s,
237 'Mutal recursion between Perl_load_module and PerlIO_find_layer croaks');
242 $main::PerlIO_code_injection = 0;
243 local $SIG{__WARN__} = sub {};
244 PerlIO->import('via; $main::PerlIO_code_injection = 1');
245 ok !$main::PerlIO_code_injection, "Can't inject code via PerlIO->import";