bump to 0.52
[imager.git] / t / t07iolayer.t
CommitLineData
c35f2f76
TC
1#!perl -w
2use strict;
13eb8ccd 3use lib 't';
1f6c1c10 4use Test::More tests => 64;
13eb8ccd
TC
5# for SEEK_SET etc, Fcntl doesn't provide these in 5.005_03
6use IO::Seekable;
c35f2f76
TC
7
8BEGIN { use_ok(Imager => ':all') };
4dfa5522 9
c35f2f76 10init_log("testout/t07iolayer.log", 1);
4dfa5522
AMH
11
12undef($/);
13# start by testing io buffer
14
c35f2f76
TC
15my $data="P2\n2 2\n255\n 255 0\n0 255\n";
16my $IO = Imager::io_new_buffer($data);
17my $im = Imager::i_readpnm_wiol($IO, -1);
4dfa5522 18
c35f2f76 19ok($im, "read from data io");
4dfa5522
AMH
20
21open(FH, ">testout/t07.ppm") or die $!;
22binmode(FH);
c35f2f76
TC
23my $fd = fileno(FH);
24my $IO2 = Imager::io_new_fd( $fd );
4dfa5522
AMH
25Imager::i_writeppm_wiol($im, $IO2);
26close(FH);
27undef($im);
28
4dfa5522 29open(FH, "<testimg/penguin-base.ppm");
866278a5 30binmode(FH);
4dfa5522
AMH
31$data = <FH>;
32close(FH);
c35f2f76 33my $IO3 = Imager::io_new_buffer($data);
4dfa5522
AMH
34#undef($data);
35$im = Imager::i_readpnm_wiol($IO3, -1);
36
c35f2f76 37ok($im, "read from buffer, for compare");
10461f9a 38undef $IO3;
4dfa5522
AMH
39
40open(FH, "<testimg/penguin-base.ppm") or die $!;
41binmode(FH);
42$fd = fileno(FH);
c35f2f76
TC
43my $IO4 = Imager::io_new_fd( $fd );
44my $im2 = Imager::i_readpnm_wiol($IO4, -1);
4dfa5522
AMH
45close(FH);
46undef($IO4);
47
c35f2f76 48ok($im2, "read from file, for compare");
4dfa5522 49
c35f2f76 50is(i_img_diff($im, $im2), 0, "compare images");
4dfa5522
AMH
51undef($im2);
52
c35f2f76 53my $IO5 = Imager::io_new_bufchain();
4dfa5522 54Imager::i_writeppm_wiol($im, $IO5);
c35f2f76 55my $data2 = Imager::io_slurp($IO5);
4dfa5522
AMH
56undef($IO5);
57
c35f2f76 58ok($data2, "check we got data from bufchain");
4dfa5522 59
c35f2f76
TC
60my $IO6 = Imager::io_new_buffer($data2);
61my $im3 = Imager::i_readpnm_wiol($IO6, -1);
4dfa5522 62
c35f2f76 63is(Imager::i_img_diff($im, $im3), 0, "read from buffer");
10461f9a
TC
64
65my $work = $data;
66my $pos = 0;
67sub io_reader {
68 my ($size, $maxread) = @_;
69 my $out = substr($work, $pos, $maxread);
70 $pos += length $out;
71 $out;
72}
73sub io_reader2 {
74 my ($size, $maxread) = @_;
75 my $out = substr($work, $pos, $maxread);
76 $pos += length $out;
77 $out;
78}
79my $IO7 = Imager::io_new_cb(undef, \&io_reader, undef, undef);
c35f2f76 80ok($IO7, "making readcb object");
10461f9a 81my $im4 = Imager::i_readpnm_wiol($IO7, -1);
c35f2f76
TC
82ok($im4, "read from cb");
83ok(Imager::i_img_diff($im, $im4) == 0, "read from cb image match");
10461f9a
TC
84
85$pos = 0;
86$IO7 = Imager::io_new_cb(undef, \&io_reader2, undef, undef);
c35f2f76 87ok($IO7, "making short readcb object");
10461f9a 88my $im5 = Imager::i_readpnm_wiol($IO7, -1);
c35f2f76
TC
89ok($im4, "read from cb2");
90is(Imager::i_img_diff($im, $im5), 0, "read from cb2 image match");
10461f9a
TC
91
92sub io_writer {
93 my ($what) = @_;
94 substr($work, $pos, $pos+length $what) = $what;
95 $pos += length $what;
96
97 1;
98}
99
100my $did_close;
101sub io_close {
102 ++$did_close;
103}
104
105my $IO8 = Imager::io_new_cb(\&io_writer, undef, undef, \&io_close);
c35f2f76 106ok($IO8, "making writecb object");
10461f9a
TC
107$pos = 0;
108$work = '';
c35f2f76 109ok(Imager::i_writeppm_wiol($im, $IO8), "write to cb");
10461f9a
TC
110# I originally compared this to $data, but that doesn't include the
111# Imager header
c35f2f76
TC
112ok($work eq $data2, "write image match");
113ok($did_close, "did close");
10461f9a
TC
114
115# with a short buffer, no closer
116my $IO9 = Imager::io_new_cb(\&io_writer, undef, undef, undef, 1);
c35f2f76 117ok($IO9, "making short writecb object");
10461f9a
TC
118$pos = 0;
119$work = '';
c35f2f76
TC
120ok(Imager::i_writeppm_wiol($im, $IO9), "write to short cb");
121ok($work eq $data2, "short write image match");
122
eda1622c
TC
123{
124 my $buf_data = "Test data";
125 my $io9 = Imager::io_new_buffer($buf_data);
126 is(ref $io9, "Imager::IO", "check class");
127 my $work;
128 is($io9->read($work, 4), 4, "read 4 from buffer object");
129 is($work, "Test", "check data read");
130 is($io9->read($work, 5), 5, "read the rest");
131 is($work, " data", "check data read");
132 is($io9->seek(5, SEEK_SET), 5, "seek");
133 is($io9->read($work, 5), 4, "short read");
134 is($work, "data", "check data read");
135 is($io9->seek(-1, SEEK_CUR), 8, "seek relative");
136 is($io9->seek(-5, SEEK_END), 4, "seek relative to end");
137 is($io9->seek(-10, SEEK_CUR), -1, "seek failure");
138 undef $io9;
139}
140{
141 my $io = Imager::io_new_bufchain();
142 is(ref $io, "Imager::IO", "check class");
143 is($io->write("testdata"), 8, "check write");
144 is($io->seek(-8, SEEK_CUR), 0, "seek relative");
145 my $work;
146 is($io->read($work, 8), 8, "check read");
147 is($work, "testdata", "check data read");
148 is($io->seek(-3, SEEK_END), 5, "seek end relative");
149 is($io->read($work, 5), 3, "short read");
150 is($work, "ata", "check read data");
151 is($io->seek(4, SEEK_SET), 4, "absolute seek to write some");
152 is($io->write("testdata"), 8, "write");
153 is($io->seek(0, SEEK_CUR), 12, "check size");
154 $io->close();
155
156 # grab the data
157 my $data = Imager::io_slurp($io);
158 is($data, "testtestdata", "check we have the right data");
159}
1f6c1c10
TC
160
161{ # callback failure checks
162 my $fail_io = Imager::io_new_cb(\&fail_write, \&fail_read, \&fail_seek, undef, 1);
163 # scalar context
164 my $buffer;
165 my $read_result = $fail_io->read($buffer, 10);
166 is($read_result, undef, "read failure undef in scalar context");
167 my @read_result = $fail_io->read($buffer, 10);
168 is(@read_result, 0, "empty list in list context");
169 $read_result = $fail_io->read2(10);
170 is($read_result, undef, "read2 failure (scalar)");
171 @read_result = $fail_io->read2(10);
172 is(@read_result, 0, "read2 failure (list)");
173
174 my $write_result = $fail_io->write("test");
175 is($write_result, -1, "failed write");
176
177 my $seek_result = $fail_io->seek(-1, SEEK_SET);
178 is($seek_result, -1, "failed seek");
179}
180
181{ # callback success checks
182 my $good_io = Imager::io_new_cb(\&good_write, \&good_read, \&good_seek, undef, 1);
183 # scalar context
184 my $buffer;
185 my $read_result = $good_io->read($buffer, 10);
186 is($read_result, 10, "read success (scalar)");
187 is($buffer, "testdatate", "check data");
188 my @read_result = $good_io->read($buffer, 10);
189 is_deeply(\@read_result, [ 10 ], "read success (list)");
190 is($buffer, "testdatate", "check data");
191 $read_result = $good_io->read2(10);
192 is($read_result, "testdatate", "read2 success (scalar)");
193 @read_result = $good_io->read2(10);
194 is_deeply(\@read_result, [ "testdatate" ], "read2 success (list)");
195}
196
197{ # end of file
198 my $eof_io = Imager::io_new_cb(undef, \&eof_read, undef, undef, 1);
199 my $buffer;
200 my $read_result = $eof_io->read($buffer, 10);
201 is($read_result, 0, "read eof (scalar)");
202 is($buffer, '', "check data");
203 my @read_result = $eof_io->read($buffer, 10);
204 is_deeply(\@read_result, [ 0 ], "read eof (list)");
205 is($buffer, '', "check data");
206}
207
208{ # no callbacks
209 my $none_io = Imager::io_new_cb(undef, undef, undef, undef, 0);
210 is($none_io->write("test"), -1, "write with no writecb should fail");
211 my $buffer;
212 is($none_io->read($buffer, 10), undef, "read with no readcb should fail");
213 is($none_io->seek(0, SEEK_SET), -1, "seek with no seekcb should fail");
214}
215
216SKIP:
217{ # make sure we croak when trying to write a string with characters over 0xff
218 # the write callback shouldn't get called
219 skip("no native UTF8 support in this version of perl", 2)
220 unless $] >= 5.006;
221 my $io = Imager::io_new_cb(\&good_write, undef, undef, 1);
222 my $data = chr(0x100);
223 is(ord $data, 0x100, "make sure we got what we expected");
224 my $result =
225 eval {
226 $io->write($data);
227 };
228 ok($@, "should have croaked")
229 and print "# $@\n";
230}
231
232sub eof_read {
233 my ($max_len) = @_;
234
235 return '';
236}
237
238sub good_read {
239 my ($max_len) = @_;
240
241 my $data = "testdata";
242 length $data <= $max_len or substr($data, $max_len) = '';
243
244 print "# good_read ($max_len) => $data\n";
245
246 return $data;
247}
248
249sub fail_write {
250 return;
251}
252
253sub fail_read {
254 return;
255}
256
257sub fail_seek {
258 return -1;
259}