io_glue_destroy() now uses an extra callback to handle type specific
[imager.git] / t / t07iolayer.t
CommitLineData
c35f2f76
TC
1#!perl -w
2use strict;
3use Test::More tests => 20;
4
5BEGIN { use_ok(Imager => ':all') };
4dfa5522 6
c35f2f76 7init_log("testout/t07iolayer.log", 1);
4dfa5522
AMH
8
9undef($/);
10# start by testing io buffer
11
c35f2f76
TC
12my $data="P2\n2 2\n255\n 255 0\n0 255\n";
13my $IO = Imager::io_new_buffer($data);
14my $im = Imager::i_readpnm_wiol($IO, -1);
4dfa5522 15
c35f2f76 16ok($im, "read from data io");
4dfa5522
AMH
17
18open(FH, ">testout/t07.ppm") or die $!;
19binmode(FH);
c35f2f76
TC
20my $fd = fileno(FH);
21my $IO2 = Imager::io_new_fd( $fd );
4dfa5522
AMH
22Imager::i_writeppm_wiol($im, $IO2);
23close(FH);
24undef($im);
25
4dfa5522 26open(FH, "<testimg/penguin-base.ppm");
866278a5 27binmode(FH);
4dfa5522
AMH
28$data = <FH>;
29close(FH);
c35f2f76 30my $IO3 = Imager::io_new_buffer($data);
4dfa5522
AMH
31#undef($data);
32$im = Imager::i_readpnm_wiol($IO3, -1);
33
c35f2f76 34ok($im, "read from buffer, for compare");
10461f9a 35undef $IO3;
4dfa5522
AMH
36
37open(FH, "<testimg/penguin-base.ppm") or die $!;
38binmode(FH);
39$fd = fileno(FH);
c35f2f76
TC
40my $IO4 = Imager::io_new_fd( $fd );
41my $im2 = Imager::i_readpnm_wiol($IO4, -1);
4dfa5522
AMH
42close(FH);
43undef($IO4);
44
c35f2f76 45ok($im2, "read from file, for compare");
4dfa5522 46
c35f2f76 47is(i_img_diff($im, $im2), 0, "compare images");
4dfa5522
AMH
48undef($im2);
49
c35f2f76 50my $IO5 = Imager::io_new_bufchain();
4dfa5522 51Imager::i_writeppm_wiol($im, $IO5);
c35f2f76 52my $data2 = Imager::io_slurp($IO5);
4dfa5522
AMH
53undef($IO5);
54
c35f2f76 55ok($data2, "check we got data from bufchain");
4dfa5522 56
c35f2f76
TC
57my $IO6 = Imager::io_new_buffer($data2);
58my $im3 = Imager::i_readpnm_wiol($IO6, -1);
4dfa5522 59
c35f2f76 60is(Imager::i_img_diff($im, $im3), 0, "read from buffer");
10461f9a
TC
61
62my $work = $data;
63my $pos = 0;
64sub io_reader {
65 my ($size, $maxread) = @_;
66 my $out = substr($work, $pos, $maxread);
67 $pos += length $out;
68 $out;
69}
70sub io_reader2 {
71 my ($size, $maxread) = @_;
72 my $out = substr($work, $pos, $maxread);
73 $pos += length $out;
74 $out;
75}
76my $IO7 = Imager::io_new_cb(undef, \&io_reader, undef, undef);
c35f2f76 77ok($IO7, "making readcb object");
10461f9a 78my $im4 = Imager::i_readpnm_wiol($IO7, -1);
c35f2f76
TC
79ok($im4, "read from cb");
80ok(Imager::i_img_diff($im, $im4) == 0, "read from cb image match");
10461f9a
TC
81
82$pos = 0;
83$IO7 = Imager::io_new_cb(undef, \&io_reader2, undef, undef);
c35f2f76 84ok($IO7, "making short readcb object");
10461f9a 85my $im5 = Imager::i_readpnm_wiol($IO7, -1);
c35f2f76
TC
86ok($im4, "read from cb2");
87is(Imager::i_img_diff($im, $im5), 0, "read from cb2 image match");
10461f9a
TC
88
89sub io_writer {
90 my ($what) = @_;
91 substr($work, $pos, $pos+length $what) = $what;
92 $pos += length $what;
93
94 1;
95}
96
97my $did_close;
98sub io_close {
99 ++$did_close;
100}
101
102my $IO8 = Imager::io_new_cb(\&io_writer, undef, undef, \&io_close);
c35f2f76 103ok($IO8, "making writecb object");
10461f9a
TC
104$pos = 0;
105$work = '';
c35f2f76 106ok(Imager::i_writeppm_wiol($im, $IO8), "write to cb");
10461f9a
TC
107# I originally compared this to $data, but that doesn't include the
108# Imager header
c35f2f76
TC
109ok($work eq $data2, "write image match");
110ok($did_close, "did close");
10461f9a
TC
111
112# with a short buffer, no closer
113my $IO9 = Imager::io_new_cb(\&io_writer, undef, undef, undef, 1);
c35f2f76 114ok($IO9, "making short writecb object");
10461f9a
TC
115$pos = 0;
116$work = '';
c35f2f76
TC
117ok(Imager::i_writeppm_wiol($im, $IO9), "write to short cb");
118ok($work eq $data2, "short write image match");
119