This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
826cf383ae7ebd7138fecf66f90e2c729f7e5006
[perl5.git] / t / op / sysio.t
1 #!./perl
2
3 print "1..36\n";
4
5 chdir('op') || die "sysio.t: cannot look for myself: $!";
6
7 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
8
9 $reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos');
10
11 $x = 'abc';
12
13 # should not be able to do negative lengths
14 eval { sysread(I, $x, -1) };
15 print 'not ' unless ($@ =~ /^Negative length /);
16 print "ok 1\n";
17
18 # $x should be intact
19 print 'not ' unless ($x eq 'abc');
20 print "ok 2\n";
21
22 # should not be able to read before the buffer
23 eval { sysread(I, $x, 1, -4) };
24 print 'not ' unless ($x eq 'abc');
25 print "ok 3\n";
26
27 # $x should be intact
28 print 'not ' unless ($x eq 'abc');
29 print "ok 4\n";
30
31 $a ='0123456789';
32
33 # default offset 0
34 print 'not ' unless(sysread(I, $a, 3) == 3);
35 print "ok 5\n";
36
37 # $a should be as follows
38 print 'not ' unless ($a eq '#!.');
39 print "ok 6\n";
40
41 # reading past the buffer should zero pad
42 print 'not ' unless(sysread(I, $a, 2, 5) == 2);
43 print "ok 7\n";
44
45 # the zero pad should be seen now
46 print 'not ' unless ($a eq "#!.\0\0/p");
47 print "ok 8\n";
48
49 # try changing the last two characters of $a
50 print 'not ' unless(sysread(I, $a, 3, -2) == 3);
51 print "ok 9\n";
52
53 # the last two characters of $a should have changed (into three)
54 print 'not ' unless ($a eq "#!.\0\0erl");
55 print "ok 10\n";
56
57 $outfile = 'sysio.out';
58
59 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
60
61 select(O); $|=1; select(STDOUT);
62
63 # cannot write negative lengths
64 eval { syswrite(O, $x, -1) };
65 print 'not ' unless ($@ =~ /^Negative length /);
66 print "ok 11\n";
67
68 # $x still intact
69 print 'not ' unless ($x eq 'abc');
70 print "ok 12\n";
71
72 # $outfile still intact
73 print 'not ' if (-s $outfile);
74 print "ok 13\n";
75
76 # should not be able to write from after the buffer
77 eval { syswrite(O, $x, 1, 3) };
78 print 'not ' unless ($@ =~ /^Offset outside string /);
79 print "ok 14\n";
80
81 # $x still intact
82 print 'not ' unless ($x eq 'abc');
83 print "ok 15\n";
84
85 # $outfile still intact
86 if ($reopen) {  # must close file to update EOF marker for stat
87   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
88 }
89 print 'not ' if (-s $outfile);
90 print "ok 16\n";
91
92 # should not be able to write from before the buffer
93
94 eval { syswrite(O, $x, 1, -4) };
95 print 'not ' unless ($@ =~ /^Offset outside string /);
96 print "ok 17\n";
97
98 # $x still intact
99 print 'not ' unless ($x eq 'abc');
100 print "ok 18\n";
101
102 # $outfile still intact
103 if ($reopen) {  # must close file to update EOF marker for stat
104   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
105 }
106 print 'not ' if (-s $outfile);
107 print "ok 19\n";
108
109 # default offset 0
110 print 'not ' unless (syswrite(O, $a, 2) == 2);
111 print "ok 20\n";
112
113 # $a still intact
114 print 'not ' unless ($a eq "#!.\0\0erl");
115 print "ok 21\n";
116
117 # $outfile should have grown now
118 if ($reopen) {  # must close file to update EOF marker for stat
119   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
120 }
121 print 'not ' unless (-s $outfile == 2);
122 print "ok 22\n";
123
124 # with offset
125 print 'not ' unless (syswrite(O, $a, 2, 5) == 2);
126 print "ok 23\n";
127
128 # $a still intact
129 print 'not ' unless ($a eq "#!.\0\0erl");
130 print "ok 24\n";
131
132 # $outfile should have grown now
133 if ($reopen) {  # must close file to update EOF marker for stat
134   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
135 }
136 print 'not ' unless (-s $outfile == 4);
137 print "ok 25\n";
138
139 # with negative offset and a bit too much length
140 print 'not ' unless (syswrite(O, $a, 5, -3) == 3);
141 print "ok 26\n";
142
143 # $a still intact
144 print 'not ' unless ($a eq "#!.\0\0erl");
145 print "ok 27\n";
146
147 # $outfile should have grown now
148 if ($reopen) {  # must close file to update EOF marker for stat
149   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
150 }
151 print 'not ' unless (-s $outfile == 7);
152 print "ok 28\n";
153
154 close(O);
155
156 open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
157
158 $b = 'xyz';
159
160 # reading too much only return as much as available
161 print 'not ' unless (sysread(I, $b, 100) == 7);
162 print "ok 29\n";
163 # this we should have
164 print 'not ' unless ($b eq '#!ererl');
165 print "ok 30\n";
166
167 # test sysseek
168
169 print 'not ' unless sysseek(I, 2, 0) == 2;
170 print "ok 31\n";
171 sysread(I, $b, 3);
172 print 'not ' unless $b eq 'ere';
173 print "ok 32\n";
174
175 print 'not ' unless sysseek(I, -2, 1) == 3;
176 print "ok 33\n";
177 sysread(I, $b, 4);
178 print 'not ' unless $b eq 'rerl';
179 print "ok 34\n";
180
181 print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
182 print "ok 35\n";
183 print 'not ' if defined sysseek(I, -1, 1);
184 print "ok 36\n";
185
186 close(I);
187
188 unlink $outfile;
189
190 chdir('..'); 
191
192 1;
193
194 # eof