This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Add hook for re_dup() into regex engine as reg_dupe (make re pluggable...
[perl5.git] / ext / PerlIO / t / scalar.t
CommitLineData
f6c77cf1
NIS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
0c4f7ff0 6 unless (find PerlIO::Layer 'perlio') {
f6c77cf1
NIS
7 print "1..0 # Skip: not perlio\n";
8 exit 0;
9 }
740dabb8 10 require Config;
98641f60 11 if (($Config::Config{'extensions'} !~ m!\bPerlIO/scalar\b!) ){
740dabb8
NC
12 print "1..0 # Skip -- Perl configured without PerlIO::scalar module\n";
13 exit 0;
14 }
f6c77cf1
NIS
15}
16
17$| = 1;
b35bc0c6 18print "1..30\n";
f6c77cf1
NIS
19
20my $fh;
21my $var = "ok 2\n";
22open($fh,"+<",\$var) or print "not ";
23print "ok 1\n";
24print <$fh>;
25print "not " unless eof($fh);
26print "ok 3\n";
27seek($fh,0,0) or print "not ";
28print "not " if eof($fh);
29print "ok 4\n";
30print "ok 5\n";
31print $fh "ok 7\n" or print "not ";
32print "ok 6\n";
33print $var;
34$var = "foo\nbar\n";
35seek($fh,0,0) or print "not ";
36print "not " if eof($fh);
37print "ok 8\n";
38print "not " unless <$fh> eq "foo\n";
39print "ok 9\n";
ae1204bf
BS
40my $rv = close $fh;
41if (!$rv) {
42 print "# Close on scalar failed: $!\n";
43 print "not ";
44}
773aa825 45print "ok 10\n";
ae1204bf
BS
46
47# Test that semantics are similar to normal file-based I/O
48# Check that ">" clobbers the scalar
49$var = "Something";
50open $fh, ">", \$var;
51print "# Got [$var], expect []\n";
52print "not " unless $var eq "";
53print "ok 11\n";
54# Check that file offset set to beginning of scalar
55my $off = tell($fh);
56print "# Got $off, expect 0\n";
57print "not " unless $off == 0;
58print "ok 12\n";
59# Check that writes go where they should and update the offset
60$var = "Something";
61print $fh "Brea";
62$off = tell($fh);
63print "# Got $off, expect 4\n";
64print "not " unless $off == 4;
65print "ok 13\n";
66print "# Got [$var], expect [Breathing]\n";
67print "not " unless $var eq "Breathing";
68print "ok 14\n";
c350b88c 69close $fh;
ae1204bf
BS
70
71# Check that ">>" appends to the scalar
72$var = "Something ";
c350b88c 73open $fh, ">>", \$var;
ae1204bf
BS
74$off = tell($fh);
75print "# Got $off, expect 10\n";
76print "not " unless $off == 10;
77print "ok 15\n";
78print "# Got [$var], expect [Something ]\n";
79print "not " unless $var eq "Something ";
80print "ok 16\n";
81# Check that further writes go to the very end of the scalar
82$var .= "else ";
83print "# Got [$var], expect [Something else ]\n";
84print "not " unless $var eq "Something else ";
85print "ok 17\n";
86$off = tell($fh);
87print "# Got $off, expect 10\n";
88print "not " unless $off == 10;
89print "ok 18\n";
90print $fh "is here";
91print "# Got [$var], expect [Something else is here]\n";
92print "not " unless $var eq "Something else is here";
93print "ok 19\n";
23a2eb0a
BS
94close $fh;
95
96# Check that updates to the scalar from elsewhere do not
97# cause problems
98$var = "line one\nline two\line three\n";
99open $fh, "<", \$var;
100while (<$fh>) {
101 $var = "foo";
102}
103close $fh;
104print "# Got [$var], expect [foo]\n";
105print "not " unless $var eq "foo";
106print "ok 20\n";
ecdeb87c
NIS
107
108# Check that dup'ing the handle works
109
110$var = '';
111
112open $fh, "+>", \$var;
113print $fh "ok 21\n";
114open $dup,'+<&',$fh;
115print $dup "ok 22\n";
116seek($dup,0,0);
117while (<$dup>) {
118 print;
119}
120close($fh);
121close($dup);
122
34fcc551
RGS
123# Check reading from non-string scalars
124
125open $fh, '<', \42;
126print <$fh> eq "42" ? "ok 23\n" : "not ok 23\n";
127close $fh;
c5b94a97
AE
128
129# reading from magic scalars
130
131{ package P; sub TIESCALAR {bless{}} sub FETCH {"ok 24\n"} }
132tie $p, P; open $fh, '<', \$p;
133print <$fh>;
03aa69f9
RGS
134
135# don't warn when writing to an undefined scalar
136
137{
138 use warnings;
139 my $ok = 1;
140 local $SIG{__WARN__} = sub { $ok = 0; };
141 open my $fh, '>', \my $scalar;
142 print $fh "foo";
143 close $fh;
144 print $ok ? "ok 25\n" : "not ok 25\n";
145}
47cc46ee
RGS
146
147my $data = "a non-empty PV";
148$data = undef;
149open(MEM, '<', \$data) or die "Fail: $!\n";
150my $x = join '', <MEM>;
151print $x eq '' ? "ok 26\n" : "not ok 26\n";
5735c168
RGS
152
153{
154 # [perl #35929] verify that works with $/ (i.e. test PerlIOScalar_unread)
155 my $s = <<'EOF';
156line A
157line B
158a third line
159EOF
160 open(F, '<', \$s) or die "Could not open string as a file";
161 local $/ = "";
162 my $ln = <F>;
163 close F;
164 print $ln eq $s ? "ok 27\n" : "not ok 27\n";
165}
b35bc0c6
RGS
166
167# [perl #40267] PerlIO::scalar doesn't respect readonly-ness
168{
169 if (open(F, '>', \undef)) {
170 print "not ok 28\n";
171 }
172 else {
173 print "ok 28 - \$! is $!\n";
174 }
175 close F;
176 my $ro = \43;
177 if (open(F, '>', $ro)) {
178 print "not ok 29\n";
179 }
180 else {
181 print "ok 29 - \$! is $!\n";
182 }
183 close F;
184 # but we can read from it
185 if (open(F, '<', $ro)) {
186 print "ok 30\n";
187 }
188 else {
189 print "not ok 30 - \$! is $!\n";
190 }
191 close F;
192}