setcolors() and addcolors() can now accept non-object colors like most
[imager.git] / t / t07iolayer.t
CommitLineData
c35f2f76
TC
1#!perl -w
2use strict;
eda1622c
TC
3use Test::More tests => 43;
4use Fcntl ':seek';
c35f2f76
TC
5
6BEGIN { use_ok(Imager => ':all') };
4dfa5522 7
c35f2f76 8init_log("testout/t07iolayer.log", 1);
4dfa5522
AMH
9
10undef($/);
11# start by testing io buffer
12
c35f2f76
TC
13my $data="P2\n2 2\n255\n 255 0\n0 255\n";
14my $IO = Imager::io_new_buffer($data);
15my $im = Imager::i_readpnm_wiol($IO, -1);
4dfa5522 16
c35f2f76 17ok($im, "read from data io");
4dfa5522
AMH
18
19open(FH, ">testout/t07.ppm") or die $!;
20binmode(FH);
c35f2f76
TC
21my $fd = fileno(FH);
22my $IO2 = Imager::io_new_fd( $fd );
4dfa5522
AMH
23Imager::i_writeppm_wiol($im, $IO2);
24close(FH);
25undef($im);
26
4dfa5522 27open(FH, "<testimg/penguin-base.ppm");
866278a5 28binmode(FH);
4dfa5522
AMH
29$data = <FH>;
30close(FH);
c35f2f76 31my $IO3 = Imager::io_new_buffer($data);
4dfa5522
AMH
32#undef($data);
33$im = Imager::i_readpnm_wiol($IO3, -1);
34
c35f2f76 35ok($im, "read from buffer, for compare");
10461f9a 36undef $IO3;
4dfa5522
AMH
37
38open(FH, "<testimg/penguin-base.ppm") or die $!;
39binmode(FH);
40$fd = fileno(FH);
c35f2f76
TC
41my $IO4 = Imager::io_new_fd( $fd );
42my $im2 = Imager::i_readpnm_wiol($IO4, -1);
4dfa5522
AMH
43close(FH);
44undef($IO4);
45
c35f2f76 46ok($im2, "read from file, for compare");
4dfa5522 47
c35f2f76 48is(i_img_diff($im, $im2), 0, "compare images");
4dfa5522
AMH
49undef($im2);
50
c35f2f76 51my $IO5 = Imager::io_new_bufchain();
4dfa5522 52Imager::i_writeppm_wiol($im, $IO5);
c35f2f76 53my $data2 = Imager::io_slurp($IO5);
4dfa5522
AMH
54undef($IO5);
55
c35f2f76 56ok($data2, "check we got data from bufchain");
4dfa5522 57
c35f2f76
TC
58my $IO6 = Imager::io_new_buffer($data2);
59my $im3 = Imager::i_readpnm_wiol($IO6, -1);
4dfa5522 60
c35f2f76 61is(Imager::i_img_diff($im, $im3), 0, "read from buffer");
10461f9a
TC
62
63my $work = $data;
64my $pos = 0;
65sub io_reader {
66 my ($size, $maxread) = @_;
67 my $out = substr($work, $pos, $maxread);
68 $pos += length $out;
69 $out;
70}
71sub io_reader2 {
72 my ($size, $maxread) = @_;
73 my $out = substr($work, $pos, $maxread);
74 $pos += length $out;
75 $out;
76}
77my $IO7 = Imager::io_new_cb(undef, \&io_reader, undef, undef);
c35f2f76 78ok($IO7, "making readcb object");
10461f9a 79my $im4 = Imager::i_readpnm_wiol($IO7, -1);
c35f2f76
TC
80ok($im4, "read from cb");
81ok(Imager::i_img_diff($im, $im4) == 0, "read from cb image match");
10461f9a
TC
82
83$pos = 0;
84$IO7 = Imager::io_new_cb(undef, \&io_reader2, undef, undef);
c35f2f76 85ok($IO7, "making short readcb object");
10461f9a 86my $im5 = Imager::i_readpnm_wiol($IO7, -1);
c35f2f76
TC
87ok($im4, "read from cb2");
88is(Imager::i_img_diff($im, $im5), 0, "read from cb2 image match");
10461f9a
TC
89
90sub io_writer {
91 my ($what) = @_;
92 substr($work, $pos, $pos+length $what) = $what;
93 $pos += length $what;
94
95 1;
96}
97
98my $did_close;
99sub io_close {
100 ++$did_close;
101}
102
103my $IO8 = Imager::io_new_cb(\&io_writer, undef, undef, \&io_close);
c35f2f76 104ok($IO8, "making writecb object");
10461f9a
TC
105$pos = 0;
106$work = '';
c35f2f76 107ok(Imager::i_writeppm_wiol($im, $IO8), "write to cb");
10461f9a
TC
108# I originally compared this to $data, but that doesn't include the
109# Imager header
c35f2f76
TC
110ok($work eq $data2, "write image match");
111ok($did_close, "did close");
10461f9a
TC
112
113# with a short buffer, no closer
114my $IO9 = Imager::io_new_cb(\&io_writer, undef, undef, undef, 1);
c35f2f76 115ok($IO9, "making short writecb object");
10461f9a
TC
116$pos = 0;
117$work = '';
c35f2f76
TC
118ok(Imager::i_writeppm_wiol($im, $IO9), "write to short cb");
119ok($work eq $data2, "short write image match");
120
eda1622c
TC
121{
122 my $buf_data = "Test data";
123 my $io9 = Imager::io_new_buffer($buf_data);
124 is(ref $io9, "Imager::IO", "check class");
125 my $work;
126 is($io9->read($work, 4), 4, "read 4 from buffer object");
127 is($work, "Test", "check data read");
128 is($io9->read($work, 5), 5, "read the rest");
129 is($work, " data", "check data read");
130 is($io9->seek(5, SEEK_SET), 5, "seek");
131 is($io9->read($work, 5), 4, "short read");
132 is($work, "data", "check data read");
133 is($io9->seek(-1, SEEK_CUR), 8, "seek relative");
134 is($io9->seek(-5, SEEK_END), 4, "seek relative to end");
135 is($io9->seek(-10, SEEK_CUR), -1, "seek failure");
136 undef $io9;
137}
138{
139 my $io = Imager::io_new_bufchain();
140 is(ref $io, "Imager::IO", "check class");
141 is($io->write("testdata"), 8, "check write");
142 is($io->seek(-8, SEEK_CUR), 0, "seek relative");
143 my $work;
144 is($io->read($work, 8), 8, "check read");
145 is($work, "testdata", "check data read");
146 is($io->seek(-3, SEEK_END), 5, "seek end relative");
147 is($io->read($work, 5), 3, "short read");
148 is($work, "ata", "check read data");
149 is($io->seek(4, SEEK_SET), 4, "absolute seek to write some");
150 is($io->write("testdata"), 8, "write");
151 is($io->seek(0, SEEK_CUR), 12, "check size");
152 $io->close();
153
154 # grab the data
155 my $data = Imager::io_slurp($io);
156 is($data, "testtestdata", "check we have the right data");
157}