2N/A#!./perl
2N/A
2N/ABEGIN {
2N/A chdir 't' if -d 't';
2N/A @INC = '../lib';
2N/A unless (find PerlIO::Layer 'perlio') {
2N/A print "1..0 # Skip: not perlio\n";
2N/A exit 0;
2N/A }
2N/A}
2N/A
2N/A$| = 1;
2N/Aprint "1..25\n";
2N/A
2N/Amy $fh;
2N/Amy $var = "ok 2\n";
2N/Aopen($fh,"+<",\$var) or print "not ";
2N/Aprint "ok 1\n";
2N/Aprint <$fh>;
2N/Aprint "not " unless eof($fh);
2N/Aprint "ok 3\n";
2N/Aseek($fh,0,0) or print "not ";
2N/Aprint "not " if eof($fh);
2N/Aprint "ok 4\n";
2N/Aprint "ok 5\n";
2N/Aprint $fh "ok 7\n" or print "not ";
2N/Aprint "ok 6\n";
2N/Aprint $var;
2N/A$var = "foo\nbar\n";
2N/Aseek($fh,0,0) or print "not ";
2N/Aprint "not " if eof($fh);
2N/Aprint "ok 8\n";
2N/Aprint "not " unless <$fh> eq "foo\n";
2N/Aprint "ok 9\n";
2N/Amy $rv = close $fh;
2N/Aif (!$rv) {
2N/A print "# Close on scalar failed: $!\n";
2N/A print "not ";
2N/A}
2N/Aprint "ok 10\n";
2N/A
2N/A# Test that semantics are similar to normal file-based I/O
2N/A# Check that ">" clobbers the scalar
2N/A$var = "Something";
2N/Aopen $fh, ">", \$var;
2N/Aprint "# Got [$var], expect []\n";
2N/Aprint "not " unless $var eq "";
2N/Aprint "ok 11\n";
2N/A# Check that file offset set to beginning of scalar
2N/Amy $off = tell($fh);
2N/Aprint "# Got $off, expect 0\n";
2N/Aprint "not " unless $off == 0;
2N/Aprint "ok 12\n";
2N/A# Check that writes go where they should and update the offset
2N/A$var = "Something";
2N/Aprint $fh "Brea";
2N/A$off = tell($fh);
2N/Aprint "# Got $off, expect 4\n";
2N/Aprint "not " unless $off == 4;
2N/Aprint "ok 13\n";
2N/Aprint "# Got [$var], expect [Breathing]\n";
2N/Aprint "not " unless $var eq "Breathing";
2N/Aprint "ok 14\n";
2N/Aclose $fh;
2N/A
2N/A# Check that ">>" appends to the scalar
2N/A$var = "Something ";
2N/Aopen $fh, ">>", \$var;
2N/A$off = tell($fh);
2N/Aprint "# Got $off, expect 10\n";
2N/Aprint "not " unless $off == 10;
2N/Aprint "ok 15\n";
2N/Aprint "# Got [$var], expect [Something ]\n";
2N/Aprint "not " unless $var eq "Something ";
2N/Aprint "ok 16\n";
2N/A# Check that further writes go to the very end of the scalar
2N/A$var .= "else ";
2N/Aprint "# Got [$var], expect [Something else ]\n";
2N/Aprint "not " unless $var eq "Something else ";
2N/Aprint "ok 17\n";
2N/A$off = tell($fh);
2N/Aprint "# Got $off, expect 10\n";
2N/Aprint "not " unless $off == 10;
2N/Aprint "ok 18\n";
2N/Aprint $fh "is here";
2N/Aprint "# Got [$var], expect [Something else is here]\n";
2N/Aprint "not " unless $var eq "Something else is here";
2N/Aprint "ok 19\n";
2N/Aclose $fh;
2N/A
2N/A# Check that updates to the scalar from elsewhere do not
2N/A# cause problems
2N/A$var = "line one\nline two\line three\n";
2N/Aopen $fh, "<", \$var;
2N/Awhile (<$fh>) {
2N/A $var = "foo";
2N/A}
2N/Aclose $fh;
2N/Aprint "# Got [$var], expect [foo]\n";
2N/Aprint "not " unless $var eq "foo";
2N/Aprint "ok 20\n";
2N/A
2N/A# Check that dup'ing the handle works
2N/A
2N/A$var = '';
2N/A
2N/Aopen $fh, "+>", \$var;
print $fh "ok 21\n";
open $dup,'+<&',$fh;
print $dup "ok 22\n";
seek($dup,0,0);
while (<$dup>) {
print;
}
close($fh);
close($dup);
# Check reading from non-string scalars
open $fh, '<', \42;
print <$fh> eq "42" ? "ok 23\n" : "not ok 23\n";
close $fh;
# reading from magic scalars
{ package P; sub TIESCALAR {bless{}} sub FETCH {"ok 24\n"} }
tie $p, P; open $fh, '<', \$p;
print <$fh>;
# don't warn when writing to an undefined scalar
{
use warnings;
my $ok = 1;
local $SIG{__WARN__} = sub { $ok = 0; };
open my $fh, '>', \my $scalar;
print $fh "foo";
close $fh;
print $ok ? "ok 25\n" : "not ok 25\n";
}