#!perl -w
use strict;
-use Test::More tests => 68;
+use Test::More tests => 252;
# for SEEK_SET etc, Fcntl doesn't provide these in 5.005_03
use IO::Seekable;
-d "testout" or mkdir "testout";
-init_log("testout/t07iolayer.log", 1);
+$| = 1;
+
+Imager->open_log(log => "testout/t07iolayer.log");
undef($/);
# start by testing io buffer
binmode(FH);
$data = <FH>;
close(FH);
-my $IO3 = Imager::io_new_buffer($data);
+my $IO3 = Imager::IO->new_buffer($data);
#undef($data);
$im = Imager::i_readpnm_wiol($IO3, -1);
open(FH, "<testimg/penguin-base.ppm") or die $!;
binmode(FH);
$fd = fileno(FH);
-my $IO4 = Imager::io_new_fd( $fd );
+my $IO4 = Imager::IO->new_fd( $fd );
my $im2 = Imager::i_readpnm_wiol($IO4, -1);
close(FH);
undef($IO4);
$pos += length $out;
$out;
}
-my $IO7 = Imager::io_new_cb(undef, \&io_reader, undef, undef);
+my $IO7 = Imager::IO->new_cb(undef, \&io_reader, undef, undef);
ok($IO7, "making readcb object");
my $im4 = Imager::i_readpnm_wiol($IO7, -1);
ok($im4, "read from cb");
my $io9 = Imager::io_new_buffer($buf_data);
is(ref $io9, "Imager::IO", "check class");
my $work;
- is($io9->read($work, 4), 4, "read 4 from buffer object");
+ is($io9->raw_read($work, 4), 4, "read 4 from buffer object");
is($work, "Test", "check data read");
- is($io9->read($work, 5), 5, "read the rest");
+ is($io9->raw_read($work, 5), 5, "read the rest");
is($work, " data", "check data read");
- is($io9->seek(5, SEEK_SET), 5, "seek");
- is($io9->read($work, 5), 4, "short read");
+ is($io9->raw_seek(5, SEEK_SET), 5, "seek");
+ is($io9->raw_read($work, 5), 4, "short read");
is($work, "data", "check data read");
- is($io9->seek(-1, SEEK_CUR), 8, "seek relative");
- is($io9->seek(-5, SEEK_END), 4, "seek relative to end");
- is($io9->seek(-10, SEEK_CUR), -1, "seek failure");
+ is($io9->raw_seek(-1, SEEK_CUR), 8, "seek relative");
+ is($io9->raw_seek(-5, SEEK_END), 4, "seek relative to end");
+ is($io9->raw_seek(-10, SEEK_CUR), -1, "seek failure");
undef $io9;
}
{
- my $io = Imager::io_new_bufchain();
+ my $io = Imager::IO->new_bufchain();
is(ref $io, "Imager::IO", "check class");
- is($io->write("testdata"), 8, "check write");
- is($io->seek(-8, SEEK_CUR), 0, "seek relative");
+ is($io->raw_write("testdata"), 8, "check write");
+ is($io->raw_seek(-8, SEEK_CUR), 0, "seek relative");
my $work;
- is($io->read($work, 8), 8, "check read");
+ is($io->raw_read($work, 8), 8, "check read");
is($work, "testdata", "check data read");
- is($io->seek(-3, SEEK_END), 5, "seek end relative");
- is($io->read($work, 5), 3, "short read");
+ is($io->raw_seek(-3, SEEK_END), 5, "seek end relative");
+ is($io->raw_read($work, 5), 3, "short read");
is($work, "ata", "check read data");
- is($io->seek(4, SEEK_SET), 4, "absolute seek to write some");
- is($io->write("testdata"), 8, "write");
- is($io->seek(0, SEEK_CUR), 12, "check size");
- $io->close();
+ is($io->raw_seek(4, SEEK_SET), 4, "absolute seek to write some");
+ is($io->raw_write("testdata"), 8, "write");
+ is($io->raw_seek(0, SEEK_CUR), 12, "check size");
+ $io->raw_close();
# grab the data
my $data = Imager::io_slurp($io);
my $fail_io = Imager::io_new_cb(\&fail_write, \&fail_read, \&fail_seek, undef, 1);
# scalar context
my $buffer;
- my $read_result = $fail_io->read($buffer, 10);
+ my $read_result = $fail_io->raw_read($buffer, 10);
is($read_result, undef, "read failure undef in scalar context");
- my @read_result = $fail_io->read($buffer, 10);
+ my @read_result = $fail_io->raw_read($buffer, 10);
is(@read_result, 0, "empty list in list context");
- $read_result = $fail_io->read2(10);
- is($read_result, undef, "read2 failure (scalar)");
- @read_result = $fail_io->read2(10);
- is(@read_result, 0, "read2 failure (list)");
+ $read_result = $fail_io->raw_read2(10);
+ is($read_result, undef, "raw_read2 failure (scalar)");
+ @read_result = $fail_io->raw_read2(10);
+ is(@read_result, 0, "raw_read2 failure (list)");
- my $write_result = $fail_io->write("test");
+ my $write_result = $fail_io->raw_write("test");
is($write_result, -1, "failed write");
- my $seek_result = $fail_io->seek(-1, SEEK_SET);
+ my $seek_result = $fail_io->raw_seek(-1, SEEK_SET);
is($seek_result, -1, "failed seek");
}
my $good_io = Imager::io_new_cb(\&good_write, \&good_read, \&good_seek, undef, 1);
# scalar context
my $buffer;
- my $read_result = $good_io->read($buffer, 10);
- is($read_result, 10, "read success (scalar)");
- is($buffer, "testdatate", "check data");
- my @read_result = $good_io->read($buffer, 10);
- is_deeply(\@read_result, [ 10 ], "read success (list)");
- is($buffer, "testdatate", "check data");
- $read_result = $good_io->read2(10);
- is($read_result, "testdatate", "read2 success (scalar)");
- @read_result = $good_io->read2(10);
- is_deeply(\@read_result, [ "testdatate" ], "read2 success (list)");
+ my $read_result = $good_io->raw_read($buffer, 10);
+ is($read_result, 8, "read success (scalar)");
+ is($buffer, "testdata", "check data");
+ my @read_result = $good_io->raw_read($buffer, 10);
+ is_deeply(\@read_result, [ 8 ], "read success (list)");
+ is($buffer, "testdata", "check data");
+ $read_result = $good_io->raw_read2(10);
+ is($read_result, "testdata", "read2 success (scalar)");
+ @read_result = $good_io->raw_read2(10);
+ is_deeply(\@read_result, [ "testdata" ], "read2 success (list)");
}
{ # end of file
my $eof_io = Imager::io_new_cb(undef, \&eof_read, undef, undef, 1);
my $buffer;
- my $read_result = $eof_io->read($buffer, 10);
+ my $read_result = $eof_io->raw_read($buffer, 10);
is($read_result, 0, "read eof (scalar)");
is($buffer, '', "check data");
- my @read_result = $eof_io->read($buffer, 10);
+ my @read_result = $eof_io->raw_read($buffer, 10);
is_deeply(\@read_result, [ 0 ], "read eof (list)");
is($buffer, '', "check data");
}
{ # no callbacks
my $none_io = Imager::io_new_cb(undef, undef, undef, undef, 0);
- is($none_io->write("test"), -1, "write with no writecb should fail");
+ is($none_io->raw_write("test"), -1, "write with no writecb should fail");
my $buffer;
- is($none_io->read($buffer, 10), undef, "read with no readcb should fail");
- is($none_io->seek(0, SEEK_SET), -1, "seek with no seekcb should fail");
+ is($none_io->raw_read($buffer, 10), undef, "read with no readcb should fail");
+ is($none_io->raw_seek(0, SEEK_SET), -1, "seek with no seekcb should fail");
}
SKIP:
is(ord $data, 0x100, "make sure we got what we expected");
my $result =
eval {
- $io->write($data);
+ $io->raw_write($data);
};
ok($@, "should have croaked")
and print "# $@\n";
sub { print "# seek\n"; 0 },
sub { print "# close\n"; 1 });
my $buffer;
- is($io->read($buffer, 10), 10, "read 10");
+ is($io->raw_read($buffer, 10), 10, "read 10");
is($buffer, "xxxxxxxxxx", "read value");
- ok($io->write("foo"), "write");
- is($io->close, 0, "close");
+ ok($io->raw_write("foo"), "write");
+ is($io->raw_close, 0, "close");
+}
+
+SKIP:
+{ # fd_seek write failure
+ -c "/dev/full"
+ or skip("No /dev/full", 3);
+ open my $fh, "> /dev/full"
+ or skip("Can't open /dev/full: $!", 3);
+ my $io = Imager::io_new_fd(fileno($fh));
+ ok($io, "make fd io for /dev/full");
+ Imager::i_clear_error();
+ is($io->raw_write("test"), -1, "fail to write");
+ my $msg = Imager->_error_as_msg;
+ like($msg, qr/^write\(\) failure: /, "check error message");
+ print "# $msg\n";
+
+ # /dev/full succeeds on seek on Linux
+
+ undef $io;
+}
+
+SKIP:
+{ # fd_seek seek failure
+ my $seekfail = "testout/t07seekfail.dat";
+ open my $fh, "> $seekfail"
+ or skip("Can't open $seekfail: $!", 3);
+ my $io = Imager::io_new_fd(fileno($fh));
+ ok($io, "make fd io for $seekfail");
+
+ Imager::i_clear_error();
+ is($io->raw_seek(-1, SEEK_SET), -1, "shouldn't be able to seek to -1");
+ my $msg = Imager->_error_as_msg;
+ like($msg, qr/^lseek\(\) failure: /, "check error message");
+ print "# $msg\n";
+
+ undef $io;
+ close $fh;
+ unlink $seekfail;
+}
+
+SKIP:
+{ # fd_seek read failure
+ open my $fh, "> testout/t07writeonly.txt"
+ or skip("Can't open testout/t07writeonly.txt: $!", 3);
+ my $io = Imager::io_new_fd(fileno($fh));
+ ok($io, "make fd io for write-only");
+
+ Imager::i_clear_error();
+ my $buf;
+ is($io->raw_read($buf, 10), undef,
+ "file open for write shouldn't be readable");
+ my $msg = Imager->_error_as_msg;
+ like($msg, qr/^read\(\) failure: /, "check error message");
+ print "# $msg\n";
+
+ undef $io;
+}
+
+SKIP:
+{ # fd_seek eof
+ open my $fh, "> testout/t07readeof.txt"
+ or skip("Can't open testout/t07readeof.txt: $!", 5);
+ binmode $fh;
+ print $fh "test";
+ close $fh;
+ open my $fhr, "< testout/t07readeof.txt",
+ or skip("Can't open testout/t07readeof.txt: $!", 5);
+ my $io = Imager::io_new_fd(fileno($fhr));
+ ok($io, "make fd io for read eof");
+
+ Imager::i_clear_error();
+ my $buf;
+ is($io->raw_read($buf, 10), 4,
+ "10 byte read on 4 byte file should return 4");
+ my $msg = Imager->_error_as_msg;
+ is($msg, "", "should be no error message")
+ or print STDERR "# read(4) message is: $msg\n";
+
+ Imager::i_clear_error();
+ $buf = '';
+ is($io->raw_read($buf, 10), 0,
+ "10 byte read at end of 4 byte file should return 0 (eof)");
+
+ $msg = Imager->_error_as_msg;
+ is($msg, "", "should be no error message")
+ or print STDERR "# read(4), eof message is: $msg\n";
+
+ undef $io;
+}
+
+{ # buffered I/O
+ my $data="P2\n2 2\n255\n 255 0\n0 255\n";
+ my $io = Imager::io_new_buffer($data);
+
+ my $c = $io->getc();
+
+ is($c, ord "P", "getc");
+ my $peekc = $io->peekc();
+
+ is($peekc, ord "2", "peekc");
+
+ my $peekn = $io->peekn(2);
+ is($peekn, "2\n", "peekn");
+
+ $c = $io->getc();
+ is($c, ord "2", "getc after peekc/peekn");
+
+ is($io->seek(0, SEEK_SET), "0", "seek");
+ is($io->getc, ord "P", "check we got back to the start");
+}
+
+{ # test closecb result is propagated
+ my $success_cb = sub { 1 };
+ my $failure_cb = sub { 0 };
+
+ {
+ my $io = Imager::io_new_cb(undef, $success_cb, undef, $success_cb);
+ is($io->close(), 0, "test successful close");
+ }
+ {
+ my $io = Imager::io_new_cb(undef, $success_cb, undef, $failure_cb);
+ is($io->close(), -1, "test failed close");
+ }
+}
+
+{ # buffered coverage/function tests
+ # some data to play with
+ my $base = pack "C*", map rand(26) + ord("a"), 0 .. 20_001;
+
+ { # buffered accessors
+ my $io = Imager::io_new_buffer($base);
+ ok($io->set_buffered(0), "set unbuffered");
+ ok(!$io->is_buffered, "verify unbuffered");
+ ok($io->set_buffered(1), "set buffered");
+ ok($io->is_buffered, "verify buffered");
+ }
+
+ { # initial i_io_read(), buffered
+ my $pos = 0;
+ my $ops = "";
+ my $work = $base;
+ my $read = sub {
+ my ($size) = @_;
+
+ my $req_size = $size;
+
+ if ($pos + $size > length $work) {
+ $size = length($work) - $pos;
+ }
+
+ my $result = substr($work, $pos, $size);
+ $pos += $size;
+ $ops .= "R$req_size>$size;";
+
+ print "# read $req_size>$size\n";
+
+ return $result;
+ };
+ my $write = sub {
+ my ($data) = @_;
+
+ substr($work, $pos, length($data), $data);
+
+ return 1;
+ };
+ {
+ my $io = Imager::io_new_cb(undef, $read, undef, undef);
+ my $buf;
+ is($io->read($buf, 1000), 1000, "read initial 1000");
+ is($buf, substr($base, 0, 1000), "check data read");
+ is($ops, "R8192>8192;", "check read op happened to buffer size");
+
+ undef $buf;
+ is($io->read($buf, 1001), 1001, "read another 1001");
+ is($buf, substr($base, 1000, 1001), "check data read");
+ is($ops, "R8192>8192;", "should be no further reads");
+
+ undef $buf;
+ is($io->read($buf, 40_000), length($base) - 2001,
+ "read the rest in one chunk");
+ is($buf, substr($base, 2001), "check the data read");
+ my $buffer_left = 8192 - 2001;
+ my $after_buffer = length($base) - 8192;
+ is($ops, "R8192>8192;R".(40_000 - $buffer_left).">$after_buffer;R21999>0;",
+ "check we tried to read the remainder");
+ }
+ {
+ # read after write errors
+ my $io = Imager::io_new_cb($write, $read, undef, undef);
+ is($io->write("test"), 4, "write 4 bytes, io in write mode");
+ is($io->read2(10), undef, "read should fail");
+ is($io->peekn(10), undef, "peekn should fail");
+ is($io->getc(), -1, "getc should fail");
+ is($io->peekc(), -1, "peekc should fail");
+ }
+ }
+
+ {
+ my $io = Imager::io_new_buffer($base);
+ print "# buffer fill check\n";
+ ok($io, "make memory io");
+ my $buf;
+ is($io->read($buf, 4096), 4096, "read 4k");
+ is($buf, substr($base, 0, 4096), "check data is correct");
+
+ # peek a bit
+ undef $buf;
+ is($io->peekn(5120), substr($base, 4096, 5120),
+ "peekn() 5120, which should exceed the buffer, and only read the left overs");
+ }
+
+ { # initial peekn
+ my $io = Imager::io_new_buffer($base);
+ is($io->peekn(10), substr($base, 0, 10),
+ "make sure initial peekn() is sane");
+ is($io->read2(10), substr($base, 0, 10),
+ "and that reading 10 gets the expected data");
+ }
+
+ { # oversize peekn
+ my $io = Imager::io_new_buffer($base);
+ is($io->peekn(10_000), substr($base, 0, 8192),
+ "peekn() larger than buffer should return buffer-size bytes");
+ }
+
+ { # small peekn then large peekn with a small I/O back end
+ # this might happen when reading from a socket
+ my $work = $base;
+ my $pos = 0;
+ my $ops = '';
+ my $reader = sub {
+ my ($size) = @_;
+
+ my $req_size = $size;
+ # do small reads, to trigger a possible bug
+ if ($size > 10) {
+ $size = 10;
+ }
+
+ if ($pos + $size > length $work) {
+ $size = length($work) - $pos;
+ }
+
+ my $result = substr($work, $pos, $size);
+ $pos += $size;
+ $ops .= "R$req_size>$size;";
+
+ print "# read $req_size>$size\n";
+
+ return $result;
+ };
+ my $io = Imager::io_new_cb(undef, $reader, undef, undef);
+ ok($io, "small reader io");
+ is($io->peekn(25), substr($base, 0, 25), "peek 25");
+ is($ops, "R8192>10;R8182>10;R8172>10;",
+ "check we got the raw calls expected");
+ is($io->peekn(65), substr($base, 0, 65), "peek 65");
+ is($ops, "R8192>10;R8182>10;R8172>10;R8162>10;R8152>10;R8142>10;R8132>10;",
+ "check we got the raw calls expected");
+ }
+ for my $buffered (1, 0) { # peekn followed by errors
+ my $buffered_desc = $buffered ? "buffered" : "unbuffered";
+ my $read = 0;
+ my $base = "abcdef";
+ my $pos = 0;
+ my $reader = sub {
+ my $size = shift;
+ my $req_size = $size;
+ if ($pos + $size > length $base) {
+ $size = length($base) - $pos;
+ }
+ # error instead of eof
+ if ($size == 0) {
+ print "# read $req_size>error\n";
+ return;
+ }
+ my $result = substr($base, $pos, $size);
+ $pos += $size;
+
+ print "# read $req_size>$size\n";
+
+ return $result;
+ };
+ my $io = Imager::io_new_cb(undef, $reader, undef, undef);
+ ok($io, "make $buffered_desc cb with error after 6 bytes");
+ is($io->peekn(5), "abcde",
+ "peekn until just before error ($buffered_desc)");
+ is($io->peekn(6), "abcdef", "peekn until error ($buffered_desc)");
+ is($io->peekn(7), "abcdef", "peekn past error ($buffered_desc)");
+ ok(!$io->error,
+ "should be no error indicator, since data buffered ($buffered_desc)");
+ ok(!$io->eof,
+ "should be no eof indicator, since data buffered ($buffered_desc)");
+
+ # consume it
+ is($io->read2(6), "abcdef", "consume the buffer ($buffered_desc)");
+ is($io->peekn(10), undef,
+ "peekn should get an error indicator ($buffered_desc)");
+ ok($io->error, "should be an error state ($buffered_desc)");
+ ok(!$io->eof, "but not eof ($buffered_desc)");
+ }
+ { # peekn on an empty file
+ my $io = Imager::io_new_buffer("");
+ is($io->peekn(10), "", "peekn on empty source");
+ ok($io->eof, "should be in eof state");
+ ok(!$io->error, "but not error");
+ }
+ { # peekn on error source
+ my $io = Imager::io_new_cb(undef, sub { return; }, undef, undef);
+ is($io->peekn(10), undef, "peekn on empty source");
+ ok($io->error, "should be in error state");
+ ok(!$io->eof, "but not eof");
+ }
+ { # peekn on short source
+ my $io = Imager::io_new_buffer("abcdef");
+ is($io->peekn(4), "abcd", "peekn 4 on 6 byte source");
+ is($io->peekn(10), "abcdef", "followed by peekn 10 on 6 byte source");
+ is($io->peekn(10), "abcdef", "and again, now eof is set");
+ }
+ { # peekn(0)
+ Imager::i_clear_error();
+ my $io = Imager::io_new_buffer("abcdef");
+ is($io->peekn(0), undef, "peekn 0 on 6 byte source");
+ my $msg = Imager->_error_as_msg;
+ is($msg, "peekn size must be positive");
+ }
+ { # getc through a whole file (buffered)
+ my $io = Imager::io_new_buffer($base);
+ my $out = '';
+ while ((my $c = $io->getc()) != -1) {
+ $out .= chr($c);
+ }
+ is($out, $base, "getc should return the file byte by byte (buffered)");
+ is($io->getc, -1, "another getc after eof should fail too");
+ ok($io->eof, "should be marked eof");
+ ok(!$io->error, "shouldn't be marked in error");
+ }
+ { # getc through a whole file (unbuffered)
+ my $io = Imager::io_new_buffer($base);
+ $io->set_buffered(0);
+ my $out = '';
+ while ((my $c = $io->getc()) != -1) {
+ $out .= chr($c);
+ }
+ is($out, $base, "getc should return the file byte by byte (unbuffered)");
+ is($io->getc, -1, "another getc after eof should fail too");
+ ok($io->eof, "should be marked eof");
+ ok(!$io->error, "shouldn't be marked in error");
+ }
+ { # buffered getc with an error
+ my $io = Imager::io_new_cb(undef, sub { return; }, undef, undef);
+ is($io->getc, -1, "buffered getc error");
+ ok($io->error, "io marked in error");
+ ok(!$io->eof, "but not eof");
+ }
+ { # unbuffered getc with an error
+ my $io = Imager::io_new_cb(undef, sub { return; }, undef, undef);
+ $io->set_buffered(0);
+ is($io->getc, -1, "unbuffered getc error");
+ ok($io->error, "io marked in error");
+ ok(!$io->eof, "but not eof");
+ }
+ { # initial peekc - buffered
+ my $io = Imager::io_new_buffer($base);
+ my $c = $io->peekc;
+ is($c, ord($base), "buffered peekc matches");
+ is($io->peekc, $c, "duplicate peekc matchess");
+ }
+ { # initial peekc - unbuffered
+ my $io = Imager::io_new_buffer($base);
+ $io->set_buffered(0);
+ my $c = $io->peekc;
+ is($c, ord($base), "unbuffered peekc matches");
+ is($io->peekc, $c, "duplicate peekc matchess");
+ }
+ { # initial peekc eof - buffered
+ my $io = Imager::io_new_cb(undef, sub { "" }, undef, undef);
+ my $c = $io->peekc;
+ is($c, -1, "buffered eof peekc is -1");
+ is($io->peekc, $c, "duplicate matches");
+ ok($io->eof, "io marked eof");
+ ok(!$io->error, "but not error");
+ }
+ { # initial peekc eof - unbuffered
+ my $io = Imager::io_new_cb(undef, sub { "" }, undef, undef);
+ $io->set_buffered(0);
+ my $c = $io->peekc;
+ is($c, -1, "buffered eof peekc is -1");
+ is($io->peekc, $c, "duplicate matches");
+ ok($io->eof, "io marked eof");
+ ok(!$io->error, "but not error");
+ }
+ { # initial peekc error - buffered
+ my $io = Imager::io_new_cb(undef, sub { return; }, undef, undef);
+ my $c = $io->peekc;
+ is($c, -1, "buffered error peekc is -1");
+ is($io->peekc, $c, "duplicate matches");
+ ok($io->error, "io marked error");
+ ok(!$io->eof, "but not eof");
+ }
+ { # initial peekc error - unbuffered
+ my $io = Imager::io_new_cb(undef, sub { return; }, undef, undef);
+ $io->set_buffered(0);
+ my $c = $io->peekc;
+ is($c, -1, "unbuffered error peekc is -1");
+ is($io->peekc, $c, "duplicate matches");
+ ok($io->error, "io marked error");
+ ok(!$io->eof, "but not eof");
+ }
+ { # initial putc
+ my $io = Imager::io_new_bufchain();
+ is($io->putc(ord "A"), ord "A", "initial putc buffered");
+ is($io->close, 0, "close it");
+ is(Imager::io_slurp($io), "A", "check it was written");
+ }
+ { # initial putc - unbuffered
+ my $io = Imager::io_new_bufchain();
+ $io->set_buffered(0);
+ is($io->putc(ord "A"), ord "A", "initial putc unbuffered");
+ is($io->close, 0, "close it");
+ is(Imager::io_slurp($io), "A", "check it was written");
+ }
+ { # putc unbuffered with error
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ $io->set_buffered(0);
+ is($io->putc(ord "A"), -1, "initial putc unbuffered error");
+ ok($io->error, "io in error");
+ is($io->putc(ord "B"), -1, "still in error");
+ }
+ { # writes while in read state
+ my $io = Imager::io_new_cb(sub { 1 }, sub { return "AA" }, undef, undef);
+ is($io->getc, ord "A", "read to setup read buffer");
+ is($io->putc(ord "B"), -1, "putc should fail");
+ is($io->write("test"), -1, "write should fail");
+ }
+ { # buffered putc error handling
+ # tests the check for error state in the buffered putc code
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ $io->putc(ord "A");
+ ok(!$io->flush, "flush should fail");
+ ok($io->error, "should be in error state");
+ is($io->putc(ord "B"), -1, "check for error");
+ }
+ { # buffered putc flush error handling
+ # test handling of flush failure and of the error state resulting
+ # from that
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ my $i = 0;
+ while (++$i < 100_000 && $io->putc(ord "A") == ord "A") {
+ # until we have to flush and fail doing do
+ }
+ is($i, 8193, "should have failed on 8193rd byte");
+ ok($io->error, "should be in error state");
+ is($io->putc(ord "B"), -1, "next putc should fail");
+ }
+ { # buffered write flush error handling
+ # test handling of flush failure and of the error state resulting
+ # from that
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ my $i = 0;
+ while (++$i < 100_000 && $io->write("A") == 1) {
+ # until we have to flush and fail doing do
+ }
+ is($i, 8193, "should have failed on 8193rd byte");
+ ok($io->error, "should be in error state");
+ is($io->write("B"), -1, "next write should fail");
+ }
+ { # buffered read error
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ is($io->read2(10), undef, "initial read returning error");
+ ok($io->error, "should be in error state");
+ }
+ { # unbuffered read error
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ $io->set_buffered(0);
+ is($io->read2(10), undef, "initial read returning error");
+ ok($io->error, "should be in error state");
+ }
+ { # unbuffered write error
+ my $count = 0;
+ my $io = Imager::io_new_cb(sub { return $count++; }, undef, undef, undef);
+ $io->set_buffered(0);
+ is($io->write("A"), -1, "unbuffered write failure");
+ ok($io->error, "should be in error state");
+ is($io->write("BC"), -1, "should still fail");
+ }
+ { # buffered write + large write
+ my $io = Imager::io_new_bufchain();
+ is($io->write(substr($base, 0, 4096)), 4096,
+ "should be buffered");
+ is($io->write(substr($base, 4096)), length($base) - 4096,
+ "large write, should fill buffer and fall back to direct write");
+ is($io->close, 0, "close it");
+ is(Imager::io_slurp($io), $base, "make sure the data is correct");
+ }
+ { # initial large write with failure
+ # tests error handling for the case where we bypass the buffer
+ # when the write is too large to fit
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ ok($io->flush, "flush with nothing buffered should succeed");
+ is($io->write($base), -1, "large write failure");
+ ok($io->error, "should be in error state");
+ is($io->close, -1, "should fail to close");
+ }
+ { # write that causes a flush then fills the buffer a bit
+ my $io = Imager::io_new_bufchain();
+ is($io->write(substr($base, 0, 6000)), 6000, "fill the buffer a bit");
+ is($io->write(substr($base, 6000, 4000)), 4000,
+ "cause it to flush and then fill some more");
+ is($io->write(substr($base, 10000)), length($base)-10000,
+ "write out the rest of our test data");
+ is($io->close, 0, "close the stream");
+ is(Imager::io_slurp($io), $base, "make sure the data is right");
+ }
+ { # failure on flush on close
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ is($io->putc(ord "A"), ord "A", "something in the buffer");
+ ok(!$io->error, "should be no error yet");
+ is($io->close, -1, "close should failure due to flush error");
+ }
+ { # seek failure
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ is($io->seek(0, SEEK_SET), -1, "seek failure");
+ }
+ { # read a little and seek
+ my $io = Imager::io_new_buffer($base);
+ is($io->getc, ord $base, "read one");
+ is($io->getc, ord substr($base, 1, 1), "read another");
+ is($io->seek(-1, SEEK_CUR), 1, "seek relative back to origin+1");
+ is($io->getc, ord substr($base, 1, 1), "read another again");
+ }
+ { # seek with failing flush
+ my $io = Imager::io_new_cb(undef, undef, undef, undef);
+ is($io->putc(ord "A"), ord "A", "write one");
+ ok(!$io->error, "not in error mode (yet)");
+ is($io->seek(0, SEEK_SET), -1, "seek failure due to flush");
+ ok($io->error, "in error mode");
+ }
+ { # gets()
+ my $data = "test1\ntest2\ntest3";
+ my $io = Imager::io_new_buffer($data);
+ is($io->gets(6), "test1\n", "gets(6)");
+ is($io->gets(5), "test2", "gets(5) (short for the line)");
+ is($io->gets(10), "\n", "gets(10) the rest of the line (the newline)");
+ is($io->gets(), "test3", "gets(default) unterminated line");
+ }
+ { # more gets()
+ my $data = "test1\ntest2\ntest3";
+ my $io = Imager::io_new_buffer($data);
+ is($io->gets(6, ord("1")), "test1", "gets(6) (line terminator 1)");
+ is($io->gets(6, ord("2")), "\ntest2", "gets(6) (line terminator 2)");
+ is($io->gets(6, ord("3")), "\ntest3", "gets(6) (line terminator 3)");
+ is($io->getc, -1, "should be eof");
+ }
+}
+
+{ # based on discussion on IRC, user was attempting to write a TIFF
+ # image file with only a write callback, but TIFF requires seek and
+ # read callbacks when writing.
+ # https://rt.cpan.org/Ticket/Display.html?id=76782
+ my $cb = Imager::io_new_cb(undef, undef, undef, undef);
+ {
+ Imager::i_clear_error();
+ my $data;
+ is($cb->read($data, 10), undef, "default read callback should fail");
+ is(Imager->_error_as_msg(), "read callback called but no readcb supplied",
+ "check error message");
+ }
+ {
+ Imager::i_clear_error();
+ is($cb->raw_write("abc"), -1, "default write callback should fail");
+ is(Imager->_error_as_msg(), "write callback called but no writecb supplied",
+ "check error message");
+ }
+ {
+ Imager::i_clear_error();
+ is($cb->seek(0, 0), -1, "default seek callback should fail");
+ is(Imager->_error_as_msg(), "seek callback called but no seekcb supplied",
+ "check error message");
+ }
+}
+
+Imager->close_log;
+
+unless ($ENV{IMAGER_KEEP_FILES}) {
+ unlink "testout/t07.ppm", "testout/t07iolayer.log";
}
sub eof_read {
projects / imager.git / blobdiff