Commit | Line | Data |
f6c77cf1 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
0c4f7ff0 |
6 | unless (find PerlIO::Layer 'perlio') { |
f6c77cf1 |
7 | print "1..0 # Skip: not perlio\n"; |
8 | exit 0; |
9 | } |
10 | } |
11 | |
12 | $| = 1; |
c5b94a97 |
13 | print "1..24\n"; |
f6c77cf1 |
14 | |
15 | my $fh; |
16 | my $var = "ok 2\n"; |
17 | open($fh,"+<",\$var) or print "not "; |
18 | print "ok 1\n"; |
19 | print <$fh>; |
20 | print "not " unless eof($fh); |
21 | print "ok 3\n"; |
22 | seek($fh,0,0) or print "not "; |
23 | print "not " if eof($fh); |
24 | print "ok 4\n"; |
25 | print "ok 5\n"; |
26 | print $fh "ok 7\n" or print "not "; |
27 | print "ok 6\n"; |
28 | print $var; |
29 | $var = "foo\nbar\n"; |
30 | seek($fh,0,0) or print "not "; |
31 | print "not " if eof($fh); |
32 | print "ok 8\n"; |
33 | print "not " unless <$fh> eq "foo\n"; |
34 | print "ok 9\n"; |
ae1204bf |
35 | my $rv = close $fh; |
36 | if (!$rv) { |
37 | print "# Close on scalar failed: $!\n"; |
38 | print "not "; |
39 | } |
773aa825 |
40 | print "ok 10\n"; |
ae1204bf |
41 | |
42 | # Test that semantics are similar to normal file-based I/O |
43 | # Check that ">" clobbers the scalar |
44 | $var = "Something"; |
45 | open $fh, ">", \$var; |
46 | print "# Got [$var], expect []\n"; |
47 | print "not " unless $var eq ""; |
48 | print "ok 11\n"; |
49 | # Check that file offset set to beginning of scalar |
50 | my $off = tell($fh); |
51 | print "# Got $off, expect 0\n"; |
52 | print "not " unless $off == 0; |
53 | print "ok 12\n"; |
54 | # Check that writes go where they should and update the offset |
55 | $var = "Something"; |
56 | print $fh "Brea"; |
57 | $off = tell($fh); |
58 | print "# Got $off, expect 4\n"; |
59 | print "not " unless $off == 4; |
60 | print "ok 13\n"; |
61 | print "# Got [$var], expect [Breathing]\n"; |
62 | print "not " unless $var eq "Breathing"; |
63 | print "ok 14\n"; |
c350b88c |
64 | close $fh; |
ae1204bf |
65 | |
66 | # Check that ">>" appends to the scalar |
67 | $var = "Something "; |
c350b88c |
68 | open $fh, ">>", \$var; |
ae1204bf |
69 | $off = tell($fh); |
70 | print "# Got $off, expect 10\n"; |
71 | print "not " unless $off == 10; |
72 | print "ok 15\n"; |
73 | print "# Got [$var], expect [Something ]\n"; |
74 | print "not " unless $var eq "Something "; |
75 | print "ok 16\n"; |
76 | # Check that further writes go to the very end of the scalar |
77 | $var .= "else "; |
78 | print "# Got [$var], expect [Something else ]\n"; |
79 | print "not " unless $var eq "Something else "; |
80 | print "ok 17\n"; |
81 | $off = tell($fh); |
82 | print "# Got $off, expect 10\n"; |
83 | print "not " unless $off == 10; |
84 | print "ok 18\n"; |
85 | print $fh "is here"; |
86 | print "# Got [$var], expect [Something else is here]\n"; |
87 | print "not " unless $var eq "Something else is here"; |
88 | print "ok 19\n"; |
23a2eb0a |
89 | close $fh; |
90 | |
91 | # Check that updates to the scalar from elsewhere do not |
92 | # cause problems |
93 | $var = "line one\nline two\line three\n"; |
94 | open $fh, "<", \$var; |
95 | while (<$fh>) { |
96 | $var = "foo"; |
97 | } |
98 | close $fh; |
99 | print "# Got [$var], expect [foo]\n"; |
100 | print "not " unless $var eq "foo"; |
101 | print "ok 20\n"; |
ecdeb87c |
102 | |
103 | # Check that dup'ing the handle works |
104 | |
105 | $var = ''; |
106 | |
107 | open $fh, "+>", \$var; |
108 | print $fh "ok 21\n"; |
109 | open $dup,'+<&',$fh; |
110 | print $dup "ok 22\n"; |
111 | seek($dup,0,0); |
112 | while (<$dup>) { |
113 | print; |
114 | } |
115 | close($fh); |
116 | close($dup); |
117 | |
34fcc551 |
118 | # Check reading from non-string scalars |
119 | |
120 | open $fh, '<', \42; |
121 | print <$fh> eq "42" ? "ok 23\n" : "not ok 23\n"; |
122 | close $fh; |
c5b94a97 |
123 | |
124 | # reading from magic scalars |
125 | |
126 | { package P; sub TIESCALAR {bless{}} sub FETCH {"ok 24\n"} } |
127 | tie $p, P; open $fh, '<', \$p; |
128 | print <$fh>; |