4 require Config; import Config;
5 unless (find PerlIO::Layer 'perlio') {
6 print "1..0 # Skip: PerlIO not used\n";
19 my $nonexistent = "nex$$";
25 ok(open($txtfh, ">:crlf", $txt));
27 ok(open($binfh, ">:raw", $bin));
29 ok(open($utffh, ">:utf8", $utf));
41 print $utffh "foo\x{ff}\n";
42 print $utffh "bar\x{abcd}\n";
46 ok(open($txtfh, "<:crlf", $txt));
48 ok(open($binfh, "<:raw", $bin));
51 ok(open($utffh, "<:utf8", $utf));
53 is(scalar <$txtfh>, "foo\n");
54 is(scalar <$txtfh>, "bar\n");
56 is(scalar <$binfh>, "foo\n");
57 is(scalar <$binfh>, "bar\n");
59 is(scalar <$utffh>, "foo\x{ff}\n");
60 is(scalar <$utffh>, "bar\x{abcd}\n");
74 # magic temporary file via 3 arg open with undef
76 ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
77 ok( defined fileno($x), ' fileno' );
80 ok( (print "ok\n"), ' print' );
83 ok( seek($x,0,0), ' seek' );
84 is( scalar <$x>, "ok\n", ' readline' );
85 ok( tell($x) >= 3, ' tell' );
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');
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;
101 # hardcoded default temp path
102 my $perlio_tmp_file_glob = '/tmp/PerlIO_??????';
104 my @before = glob $perlio_tmp_file_glob;
106 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');
108 my @after = glob $perlio_tmp_file_glob;
109 is( "@after", "@before", "No tmp files leaked");
111 unlink_new(\@before, \@after);
114 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');
116 @after = glob $perlio_tmp_file_glob;
117 is( "@after", "@before", "No tmp files leaked");
119 unlink_new(\@before, \@after);
124 my ($before, $after) = @_;
126 @before{@$before} = ();
127 unlink grep {!exists $before{$_}} @$after;
132 eval { require PerlIO::scalar };
133 unless (find PerlIO::Layer 'scalar') {
134 skip("PerlIO::scalar not found", 9);
137 ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
138 ok( defined fileno($x), ' fileno' );
141 ok( (print "ok\n"), ' print' );
144 ok( seek($x,0,0), ' seek' );
145 is( scalar <$x>, "ok\n", ' readline' );
146 ok( tell($x) >= 3, ' tell' );
149 local $TODO = "broken";
151 # test in-memory open over STDOUT
152 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
154 my $status = open(STDOUT,">",\$var);
155 my $error = "$!" unless $status; # remember the error
156 close STDOUT unless $status;
157 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
158 print "# $error\n" unless $status;
159 # report after STDOUT is restored
160 ok($status, ' open STDOUT into in-memory var');
162 # test in-memory open over STDERR
163 open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";
165 ok( open(STDERR,">",\$var), ' open STDERR into in-memory var');
166 open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!";
170 { local $TODO = 'fails well back into 5.8.x';
173 sub read_fh_and_return_final_rv {
178 $rv = read($fh, $buf, 1, length($buf));
184 open(my $no_perlio, '<', \'ab') or die;
185 open(my $perlio, '<:crlf', \'ab') or die;
187 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");