1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
|
use strict;
use File::Path ();
use File::Spec::Functions;
use FindBin ();
use Test::More;
require Test::NoWarnings;
use Image::Scale;
my $gif_version = Image::Scale->gif_version();
my $png_version = Image::Scale->png_version();
if ($gif_version) {
plan tests => 3;
}
else {
plan skip_all => 'Image::Scale not built with giflib support';
}
my $tmpdir = catdir( $FindBin::Bin, 'tmp' );
if ( -d $tmpdir ) {
File::Path::rmtree($tmpdir);
}
mkdir $tmpdir;
# corrupt file
{
no strict 'subs';
no warnings;
Test::NoWarnings::clear_warnings();
my $im = Image::Scale->new( _f("corrupt.gif") );
# Hide stderr
open OLD_STDERR, '>&', STDERR;
close STDERR;
my $ok = $im->resize_gd_fixed_point( { width => 50 } );
# Restore stderr
open STDERR, '>&', OLD_STDERR;
is( $ok, 0, 'GIF corrupt failed resize ok' );
# Test that the correct warning was output
like( (Test::NoWarnings::warnings())[0]->getMessage, qr/Image::Scale unable to read GIF file/i, 'GIF corrupt error output ok' );
}
# Bug 17573, very thin gif could cause divide by 0 errors
SKIP:
{
skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
my $outfile = _tmp("bug17573-thin_gd_fixed_point_w40.png");
my $im = Image::Scale->new( _f('bug17573-thin.gif') );
$im->resize_gd_fixed_point( { width => 40 } );
$im->save_png($outfile);
is( _compare( _load($outfile), "bug17573-thin_gd_fixed_point_w40.png" ), 1, "GIF resize_gd_fixed_point from thin image ok" );
}
diag("giflib version: $gif_version");
END {
File::Path::rmtree($tmpdir);
}
sub _f {
return catfile( $FindBin::Bin, 'images', 'gif', shift );
}
sub _tmp {
return catfile( $tmpdir, shift );
}
sub _load {
my $path = shift;
open my $fh, '<', $path or die "Cannot open $path";
binmode $fh;
my $data = do { local $/; <$fh> };
close $fh;
return \$data;
}
sub _compare {
my ( $test, $path ) = @_;
my $ref = _load( catfile( $FindBin::Bin, 'ref', 'gif', $path ) );
return $$ref eq $$test;
}
|