Commit | Line | Data |
---|---|---|
f6c77cf1 NIS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
e0e62c2a | 6 | unless (exists $open::layers{'perlio'}) { |
f6c77cf1 NIS |
7 | print "1..0 # Skip: not perlio\n"; |
8 | exit 0; | |
9 | } | |
10 | } | |
11 | ||
12 | $| = 1; | |
ae1204bf | 13 | print "1..19\n"; |
f6c77cf1 NIS |
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 BS |
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 BS |
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 BS |
65 | |
66 | # Check that ">>" appends to the scalar | |
67 | $var = "Something "; | |
c350b88c | 68 | open $fh, ">>", \$var; |
ae1204bf BS |
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"; |