Imager::init("log"=>"testout/t50basicoo.log");
# single image/file types
-my @types = qw( jpeg png raw ppm gif tiff bmp tga );
+my @types = qw( jpeg png raw pnm gif tiff bmp tga );
# multiple image/file formats
my @mtypes = qw(tiff gif);
my $img = Imager->new();
my %files;
-@files{@types} = ({ file => "testout/t101.jpg" },
- { file => "testout/t102.png" },
- { file => "testout/t103.raw", xsize=>150, ysize=>150
- #, type=>"raw" # TODO: was this there for a reason?
- },
- { file => "testout/t104.ppm" },
- { file => "testout/t105.gif" },
- { file => "testout/t106.tiff" },
- { file => "testout/t107_24bit.bmp" },
- { file => "testout/t108_24bit.tga" }, );
+@files{@types} = ({ file => "JPEG/testimg/209_yonge.jpg" },
+ { file => "testimg/test.png" },
+ { file => "testimg/test.raw", xsize=>150, ysize=>150, type=>'raw', interleave => 0},
+ { file => "testimg/penguin-base.ppm" },
+ { file => "GIF/testimg/expected.gif" },
+ { file => "TIFF/testimg/comp8.tif" },
+ { file => "testimg/winrgb24.bmp" },
+ { file => "testimg/test.tga" }, );
my %writeopts =
(
gif=> { make_colors=>'webmap', translate=>'closest', gifquant=>'gen',
my %mopts = %opts;
delete $mopts{file};
-
+
# read from a file handle
my $fh = IO::File->new($opts{file}, "r");
if (ok($fh, "opening $opts{file}")) {
binmode $fh;
my $fhimg = Imager->new;
- Imager::log_entry("Reading file: $opts{file}\n", -1);
- my $fhrc = $fhimg->read(fh=>$fh, %mopts);
- if (ok(!$fhrc, "check that type is required")) {
- ok ($fhimg->errstr =~ /type parameter missing/, "check for no type error");
- }
- else {
- skip("previous test failed");
- }
- if (ok($fhimg->read(fh=>$fh, %mopts, type=>$type), "read from fh")) {
- ok(Imager::i_img_diff($img->{IMG}, $fhimg->{IMG}) == 0,
- "image comparison after fh read");
- }
- else {
- skip("no image to compare");
+ if (ok($fhimg->read(fh=>$fh, %mopts), "read from fh")) {
+ ok($fh->seek(0, SEEK_SET), "seek after read");
+ if (ok($fhimg->read(fh=>$fh, %mopts, type=>$type), "read from fh")) {
+ ok(Imager::i_img_diff($img->{IMG}, $fhimg->{IMG}) == 0,
+ "image comparison after fh read");
+ }
+ else {
+ skip("no image to compare");
+ }
+ ok($fh->seek(0, SEEK_SET), "seek after read");
}
- ok($fh->seek(0, SEEK_SET), "seek after read");
-
+
# read from a fd
my $fdimg = Imager->new;
- if (ok($fdimg->read(fd=>fileno($fh), %mopts, type=>$type),
- "read from fd")) {
+ if (ok($fdimg->read(fd=>fileno($fh), %mopts, type=>$type), "read from fd")) {
ok(Imager::i_img_diff($img->{IMG}, $fdimg->{IMG}) == 0,
"image comparistion after fd read");
}
skip("couldn't open the damn file: $!", 7);
}
- if ($type ne 'gif' || Imager::i_giflib_version() >= 4) {
- # read from a memory buffer
- open DATA, "< $opts{file}"
- or die "Cannot open $opts{file}: $!";
- binmode DATA;
- my $data = do { local $/; <DATA> };
- close DATA;
- my $bimg = Imager->new;
-
- if (ok($bimg->read(data=>$data, %mopts, type=>$type), "read from buffer",
- $img)) {
- ok(Imager::i_img_diff($img->{IMG}, $bimg->{IMG}) == 0,
- "comparing buffer read image");
- }
- else {
- skip("nothing to compare");
- }
-
- # read from callbacks, both with minimum and maximum reads
- my $buf = $data;
- my $seekpos = 0;
- my $reader_min =
- sub {
- my ($size, $maxread) = @_;
- my $out = substr($buf, $seekpos, $size);
- $seekpos += length $out;
- $out;
- };
- my $reader_max =
- sub {
- my ($size, $maxread) = @_;
- my $out = substr($buf, $seekpos, $maxread);
- $seekpos += length $out;
- $out;
- };
- my $seeker =
- sub {
- my ($offset, $whence) = @_;
- #print "io_seeker($offset, $whence)\n";
- if ($whence == SEEK_SET) {
- $seekpos = $offset;
- }
- elsif ($whence == SEEK_CUR) {
- $seekpos += $offset;
- }
- else { # SEEK_END
- $seekpos = length($buf) + $offset;
- }
- #print "-> $seekpos\n";
- $seekpos;
- };
- my $cbimg = Imager->new;
- ok($cbimg->read(callback=>$reader_min, seekcb=>$seeker, type=>$type, %mopts),
- "read from callback min", $cbimg);
- ok(Imager::i_img_diff($cbimg->{IMG}, $img->{IMG}) == 0,
- "comparing mincb image");
- $seekpos = 0;
- ok($cbimg->read(callback=>$reader_max, seekcb=>$seeker, type=>$type, %mopts),
- "read from callback max", $cbimg);
- ok(Imager::i_img_diff($cbimg->{IMG}, $img->{IMG}) == 0,
- "comparing maxcb image");
+ # read from a memory buffer
+ open DATA, "< $opts{file}"
+ or die "Cannot open $opts{file}: $!";
+ binmode DATA;
+ my $data = do { local $/; <DATA> };
+ close DATA;
+ my $bimg = Imager->new;
+
+ if (ok($bimg->read(data=>$data, %mopts, type=>$type), "read from buffer",
+ $img)) {
+ ok(Imager::i_img_diff($img->{IMG}, $bimg->{IMG}) == 0,
+ "comparing buffer read image");
}
else {
- skip("giflib < 4 doesn't support callbacks", 6);
+ skip("nothing to compare");
}
+
+ # read from callbacks, both with minimum and maximum reads
+ my $buf = $data;
+ my $seekpos = 0;
+ my $reader_min =
+ sub {
+ my ($size, $maxread) = @_;
+ my $out = substr($buf, $seekpos, $size);
+ $seekpos += length $out;
+ $out;
+ };
+ my $reader_max =
+ sub {
+ my ($size, $maxread) = @_;
+ my $out = substr($buf, $seekpos, $maxread);
+ $seekpos += length $out;
+ $out;
+ };
+ my $seeker =
+ sub {
+ my ($offset, $whence) = @_;
+ #print "io_seeker($offset, $whence)\n";
+ if ($whence == SEEK_SET) {
+ $seekpos = $offset;
+ }
+ elsif ($whence == SEEK_CUR) {
+ $seekpos += $offset;
+ }
+ else { # SEEK_END
+ $seekpos = length($buf) + $offset;
+ }
+ #print "-> $seekpos\n";
+ $seekpos;
+ };
+ my $cbimg = Imager->new;
+ ok($cbimg->read(callback=>$reader_min, seekcb=>$seeker, type=>$type, %mopts),
+ "read from callback min", $cbimg);
+ ok(Imager::i_img_diff($cbimg->{IMG}, $img->{IMG}) == 0,
+ "comparing mincb image");
+ $seekpos = 0;
+ ok($cbimg->read(callback=>$reader_max, seekcb=>$seeker, type=>$type, %mopts),
+ "read from callback max", $cbimg);
+ ok(Imager::i_img_diff($cbimg->{IMG}, $img->{IMG}) == 0,
+ "comparing maxcb image");
}
for my $type (@types) {
my $wimg = Imager->new;
# if this doesn't work, we're so screwed up anyway
- ok($wimg->read(file=>"testout/t104.ppm"),
+ ok($wimg->read(file=>"testimg/penguin-base.ppm"),
"cannot read base file", $wimg);
# first to a file
"write to FH after writing $type");
ok($fh->close, "closing FH after writing $type");
- if ($type ne 'gif' ||
- (Imager::i_giflib_version() >= 4 && !-e $buggy_giflib_file)) {
- if (ok(open(DATA, "< $file"), "opening data source")) {
- binmode DATA;
- my $data = do { local $/; <DATA> };
- close DATA;
-
- # writing to a buffer
- print "# writing $type to a buffer\n";
- my $buf = '';
- ok($wimg->write(data=>\$buf, %extraopts, type=>$type),
- "writing $type to a buffer", $wimg);
- $buf .= "SUFFIX\n";
- open DATA, "> testout/t50_buf.$type"
- or die "Cannot create $type buffer file: $!";
- binmode DATA;
- print DATA $buf;
- close DATA;
- ok($data eq $buf, "comparing file data to buffer");
-
- $buf = '';
- my $seekpos = 0;
- my $did_close;
- my $writer =
- sub {
- my ($what) = @_;
- if ($seekpos > length $buf) {
- $buf .= "\0" x ($seekpos - length $buf);
- }
- substr($buf, $seekpos, length $what) = $what;
- $seekpos += length $what;
- $did_close = 0; # the close must be last
- 1;
- };
- my $reader_min =
- sub {
- my ($size, $maxread) = @_;
- my $out = substr($buf, $seekpos, $size);
- $seekpos += length $out;
- $out;
- };
- my $reader_max =
- sub {
- my ($size, $maxread) = @_;
- my $out = substr($buf, $seekpos, $maxread);
- $seekpos += length $out;
- $out;
- };
- use IO::Seekable;
- my $seeker =
- sub {
- my ($offset, $whence) = @_;
- #print "io_seeker($offset, $whence)\n";
- if ($whence == SEEK_SET) {
- $seekpos = $offset;
- }
- elsif ($whence == SEEK_CUR) {
- $seekpos += $offset;
- }
- else { # SEEK_END
- $seekpos = length($buf) + $offset;
- }
- #print "-> $seekpos\n";
- $seekpos;
- };
-
- my $closer = sub { ++$did_close; };
-
- print "# writing $type via callbacks (mb=1)\n";
- ok($wimg->write(writecb=>$writer, seekcb=>$seeker, closecb=>$closer,
- readcb=>$reader_min,
- %extraopts, type=>$type, maxbuffer=>1),
- "writing $type to callback (mb=1)", $wimg);
-
- ok($did_close, "checking closecb called");
- $buf .= "SUFFIX\n";
- ok($data eq $buf, "comparing callback output to file data");
- print "# writing $type via callbacks (no mb)\n";
- $buf = '';
- $did_close = 0;
- $seekpos = 0;
- # we don't use the closecb here - used to make sure we don't get
- # a warning/error on an attempt to call an undef close sub
- ok($wimg->write(writecb=>$writer, seekcb=>$seeker, readcb=>$reader_min,
- %extraopts, type=>$type),
- "writing $type to callback (no mb)", $wimg);
- $buf .= "SUFFIX\n";
- ok($data eq $buf, "comparing callback output to file data");
- }
- else {
- skip("couldn't open data source", 7);
- }
+ if (ok(open(DATA, "< $file"), "opening data source")) {
+ binmode DATA;
+ my $data = do { local $/; <DATA> };
+ close DATA;
+
+ # writing to a buffer
+ print "# writing $type to a buffer\n";
+ my $buf = '';
+ ok($wimg->write(data=>\$buf, %extraopts, type=>$type),
+ "writing $type to a buffer", $wimg);
+ $buf .= "SUFFIX\n";
+ open DATA, "> testout/t50_buf.$type"
+ or die "Cannot create $type buffer file: $!";
+ binmode DATA;
+ print DATA $buf;
+ close DATA;
+ ok($data eq $buf, "comparing file data to buffer");
+
+ $buf = '';
+ my $seekpos = 0;
+ my $did_close;
+ my $writer =
+ sub {
+ my ($what) = @_;
+ if ($seekpos > length $buf) {
+ $buf .= "\0" x ($seekpos - length $buf);
+ }
+ substr($buf, $seekpos, length $what) = $what;
+ $seekpos += length $what;
+ $did_close = 0; # the close must be last
+ 1;
+ };
+ my $reader_min =
+ sub {
+ my ($size, $maxread) = @_;
+ my $out = substr($buf, $seekpos, $size);
+ $seekpos += length $out;
+ $out;
+ };
+ my $reader_max =
+ sub {
+ my ($size, $maxread) = @_;
+ my $out = substr($buf, $seekpos, $maxread);
+ $seekpos += length $out;
+ $out;
+ };
+ use IO::Seekable;
+ my $seeker =
+ sub {
+ my ($offset, $whence) = @_;
+ #print "io_seeker($offset, $whence)\n";
+ if ($whence == SEEK_SET) {
+ $seekpos = $offset;
+ }
+ elsif ($whence == SEEK_CUR) {
+ $seekpos += $offset;
+ }
+ else { # SEEK_END
+ $seekpos = length($buf) + $offset;
+ }
+ #print "-> $seekpos\n";
+ $seekpos;
+ };
+
+ my $closer = sub { ++$did_close; };
+
+ print "# writing $type via callbacks (mb=1)\n";
+ ok($wimg->write(writecb=>$writer, seekcb=>$seeker, closecb=>$closer,
+ readcb=>$reader_min,
+ %extraopts, type=>$type, maxbuffer=>1),
+ "writing $type to callback (mb=1)", $wimg);
+
+ ok($did_close, "checking closecb called");
+ $buf .= "SUFFIX\n";
+ ok($data eq $buf, "comparing callback output to file data");
+ print "# writing $type via callbacks (no mb)\n";
+ $buf = '';
+ $did_close = 0;
+ $seekpos = 0;
+ # we don't use the closecb here - used to make sure we don't get
+ # a warning/error on an attempt to call an undef close sub
+ ok($wimg->write(writecb=>$writer, seekcb=>$seeker, readcb=>$reader_min,
+ %extraopts, type=>$type),
+ "writing $type to callback (no mb)", $wimg);
+ $buf .= "SUFFIX\n";
+ ok($data eq $buf, "comparing callback output to file data");
}
else {
- if (-e $buggy_giflib_file) {
- skip("see $buggy_giflib_file", 8);
- }
- else {
- skip("giflib < 4 doesn't support callbacks", 8);
- }
+ skip("couldn't open data source", 7);
}
}
#print "ok 2\n";
sub ok {
- my ($ok, $msg, $img) = @_;
+ my ($ok, $msg, $img, $why, $skipcount) = @_;
++$test_num;
if ($ok) {
print "ok $test_num # $msg\n";
+ Imager::i_log_entry("ok $test_num # $msg\n", 0);
}
else {
my $err;
my $line = "not ok $test_num # line ".(caller)[2].": $msg";
$line .= ": $err" if $err;
print $line, "\n";
+ Imager::i_log_entry($line."\n", 0);
}
-
+ skip($why, $skipcount) if defined $why;
$ok;
}
projects / imager.git / blobdiff