File: gif.t

package info (click to toggle)
libimage-scale-perl 0.14%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 1,828 kB
  • sloc: ansic: 4,760; perl: 313; makefile: 3
file content (97 lines) | stat: -rw-r--r-- 2,074 bytes parent folder | download
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;
}