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
98
99
100
101
|
use strict;
use File::Path ();
use File::Spec::Functions;
use FindBin ();
use Test::More;
require Test::NoWarnings;
use Image::Scale;
### PNG tests pass with both 1.4.3 and 1.2.44, don't need to skip any
my $png_version = Image::Scale->png_version();
if ($png_version) {
plan tests => 4;
}
else {
plan skip_all => 'Image::Scale not built with libpng support';
}
my $tmpdir = catdir( $FindBin::Bin, 'tmp' );
if ( -d $tmpdir ) {
File::Path::rmtree($tmpdir);
}
mkdir $tmpdir;
# XXX palette_bkgd
# corrupt files from PNG test suite
# x00n0g01 - empty 0x0 grayscale file
# xcrn0g04 - added cr bytes
{
Test::NoWarnings::clear_warnings();
my $im = Image::Scale->new( _f("x00n0g01.png") );
# Test that $im is undef when new fails
ok( !defined $im, 'new() returns undef on error ok' );
# Test that the correct warning was output
my @warnings = Test::NoWarnings::warnings();
like( $warnings[0]->getMessage, qr/zero in IHDR/, 'PNG corrupt warning 1 output ok' );
}
{
Test::NoWarnings::clear_warnings();
my $im = Image::Scale->new( _f("xcrn0g04.png") );
# This file won't be seen as PNG, so generates a generic unknown warning
my @warnings = Test::NoWarnings::warnings();
like( $warnings[0]->getMessage, qr/Image::Scale unknown file type/, 'PNG corrupt header ok' );
}
# XXX test for valid header but error during image_png_load()
# 1-height image that would previously try to resize to 0-height
{
my $dataref = _load( _f("height1.png") );
my $outfile = _tmp("height1_resize_gd_fixed_point_w100.png");
my $im = Image::Scale->new($dataref);
$im->resize_gd_fixed_point( { width => 100 } );
$im->save_png($outfile);
is( _compare( _load($outfile), "height1_resize_gd_fixed_point_w100.png" ), 1, "PNG 1-height resize ok" );
}
diag("libpng version: $png_version");
END {
File::Path::rmtree($tmpdir);
}
sub _f {
return catfile( $FindBin::Bin, 'images', 'png', 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', 'png', $path ) );
return $$ref eq $$test;
}
|
