This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
warnings for perlio + others
[perl5.git] / ext / PerlIO / t / scalar.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     unless (find PerlIO::Layer 'perlio') {
7         print "1..0 # Skip: not perlio\n";
8         exit 0;
9     }
10 }
11
12 $| = 1;
13 print "1..22\n";
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";
35 my $rv = close $fh;
36 if (!$rv) {
37     print "# Close on scalar failed: $!\n";
38     print "not ";
39 }
40 print "ok 10\n";
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";
64 close $fh;
65
66 # Check that ">>" appends to the scalar
67 $var = "Something ";
68 open $fh, ">>", \$var;
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";
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";
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