6 unless (find PerlIO::Layer 'perlio') {
7 print "1..0 # Skip: not perlio\n";
11 if (($Config::Config{'extensions'} !~ m!\bPerlIO/scalar\b!) ){
12 print "1..0 # Skip -- Perl configured without PerlIO::scalar module\n";
17 use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere.
21 use Test::More tests => 51;
25 ok(open($fh,"+<",\$var));
31 ok(seek($fh,0,SEEK_SET));
34 ok(print $fh "bbb\n");
37 ok(seek($fh,0,SEEK_SET));
42 # Test that semantics are similar to normal file-based I/O
43 # Check that ">" clobbers the scalar
47 # Check that file offset set to beginning of scalar
50 # Check that writes go where they should and update the offset
55 is($var, "Breathing");
58 # Check that ">>" appends to the scalar
60 open $fh, ">>", \$var;
63 is($var, "Something ");
64 # Check that further writes go to the very end of the scalar
66 is($var, "Something else ");
72 is($var, "Something else is here");
75 # Check that updates to the scalar from elsewhere do not
77 $var = "line one\nline two\line three\n";
85 # Check that dup'ing the handle works
88 open $fh, "+>", \$var;
92 seek($dup,0,SEEK_SET);
99 is(<$fh>, "42", "reading from non-string scalars");
102 { package P; sub TIESCALAR {bless{}} sub FETCH { "shazam" } }
103 tie $p, P; open $fh, '<', \$p;
104 is(<$fh>, "shazam", "reading from magic scalars");
109 local $SIG{__WARN__} = sub { $warn++ };
110 open my $fh, '>', \my $scalar;
113 is($warn, 0, "no warnings when writing to an undefined scalar");
116 my $data = "a non-empty PV";
118 open(MEM, '<', \$data) or die "Fail: $!\n";
119 my $x = join '', <MEM>;
123 # [perl #35929] verify that works with $/ (i.e. test PerlIOScalar_unread)
129 open(F, '<', \$s) or die "Could not open string as a file";
133 is($ln, $s, "[perl #35929]");
136 # [perl #40267] PerlIO::scalar doesn't respect readonly-ness
138 ok(!(defined open(F, '>', \undef)), "[perl #40267] - $!");
142 ok(!(defined open(F, '>', $ro)), $!);
144 # but we can read from it
145 ok(open(F, '<', $ro), $!);
151 # Check that we zero fill when needed when seeking,
152 # and that seeking negative off the string does not do bad things.
156 ok(open(F, '>', \$foo));
158 # Seeking forward should zero fill.
160 ok(seek(F, 50, SEEK_SET));
162 is(length($foo), 51);
163 like($foo, qr/^\0{50}x$/);
166 ok(seek(F, 0, SEEK_SET));
167 is(length($foo), 51);
169 # Seeking forward again should zero fill but only the new bytes.
171 ok(seek(F, 100, SEEK_SET));
173 is(length($foo), 101);
174 like($foo, qr/^\0{50}x\0{49}y$/);
177 # Seeking back and writing should not zero fill.
179 ok(seek(F, 75, SEEK_SET));
181 is(length($foo), 101);
182 like($foo, qr/^\0{50}x\0{24}z\0{24}y$/);
185 # Seeking negative should not do funny business.
187 ok(!seek(F, -50, SEEK_SET), $!);
188 ok(seek(F, 0, SEEK_SET));
189 ok(!seek(F, -50, SEEK_CUR), $!);
190 ok(!seek(F, -150, SEEK_END), $!);