r28152 - in /branches/upstream/libimager-perl/current: ./ ICO/ ICO/t/ ICO/testimg/ lib/Imager/ lib/Imager/Font/ t/
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Sat Dec 13 01:42:48 UTC 2008
Author: rmayorga-guest
Date: Sat Dec 13 01:42:45 2008
New Revision: 28152
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28152
Log:
[svn-upgrade] Integrating new upstream version, libimager-perl (0.67)
Added:
branches/upstream/libimager-perl/current/ICO/testimg/rgb1616.ico (with props)
branches/upstream/libimager-perl/current/t/t83extutil.t
Modified:
branches/upstream/libimager-perl/current/Changes
branches/upstream/libimager-perl/current/ICO/imicon.c
branches/upstream/libimager-perl/current/ICO/msicon.c
branches/upstream/libimager-perl/current/ICO/t/t10icon.t
branches/upstream/libimager-perl/current/Imager.pm
branches/upstream/libimager-perl/current/Imager.xs
branches/upstream/libimager-perl/current/MANIFEST
branches/upstream/libimager-perl/current/META.yml
branches/upstream/libimager-perl/current/bmp.c
branches/upstream/libimager-perl/current/lib/Imager/ExtUtils.pm
branches/upstream/libimager-perl/current/lib/Imager/Files.pod
branches/upstream/libimager-perl/current/lib/Imager/Font/BBox.pm
branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod
branches/upstream/libimager-perl/current/rubthru.im
branches/upstream/libimager-perl/current/t/t023palette.t
branches/upstream/libimager-perl/current/t/t105gif.t
branches/upstream/libimager-perl/current/t/t107bmp.t
Modified: branches/upstream/libimager-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/Changes?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/Changes (original)
+++ branches/upstream/libimager-perl/current/Changes Sat Dec 13 01:42:45 2008
@@ -1,6 +1,46 @@
Imager release history. Older releases can be found in Changes.old
-Imager 0.65 - unreleased
+Imager 0.67 - 12 Dec 2008
+===========
+
+Bug fixes:
+
+ - fix a packaging error
+
+Imager 0.66 - 12 Dec 2008
+===========
+
+ - 24-bit color .ICO/.CUR files can now be read.
+
+Bug fixes:
+
+ - an optimization skipping 0 src alpha values could cause the
+ rubthrough() to read past the end of a buffer.
+ http://www.nntp.perl.org/group/perl.cpan.testers/2008/05/msg1509184.html
+
+ - corrected a reference leak where writing GIFs would leak memory.
+ This could also happen calling to_paletted().
+ Also documented the underlying long existing feature where the
+ colors parameter is filled with the generated color table and added
+ tests for it.
+ http://rt.cpan.org/Ticket/Display.html?id=41028
+
+ - write out the image size in bytes field of a BMP correctly.
+ http://rt.cpan.org/Ticket/Display.html?id=41406
+
+ - add limited tests for Imager::ExtUtils
+
+ - make Imager::ExtUtils->includes use an absolute path, since
+ a relative path could cause failures using Inline::C.
+ http://rt.cpan.org/Ticket/Display.html?id=37353
+
+ - re-arrange the POD for Imager::Font::BBox:
+ - mark total_width(), pos_width(), end_offset() obsolete, since
+ they're mostly for backwards compatibility
+ - group width methods and height methods
+ https://rt.cpan.org/Ticket/Display.html?id=39999
+
+Imager 0.65 - 20 May 2008
===========
Bug fixes:
Modified: branches/upstream/libimager-perl/current/ICO/imicon.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/ICO/imicon.c?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/ICO/imicon.c (original)
+++ branches/upstream/libimager-perl/current/ICO/imicon.c Sat Dec 13 01:42:45 2008
@@ -46,13 +46,15 @@
i_color *line_buf;
i_color *outp;
ico_color_t *inp = image->image_data;
-
- if (!i_int_check_image_file_limits(image->width, image->height, 4, 1)) {
+ int channels = masked || image->bit_count == 32 ? 4 : 3;
+
+ if (!i_int_check_image_file_limits(image->width, image->height, channels, 1)) {
ico_image_release(image);
return NULL;
}
- result = i_img_8_new(image->width, image->height, 4);
+
+ result = i_img_8_new(image->width, image->height, channels);
if (!result) {
ico_image_release(image);
return NULL;
Modified: branches/upstream/libimager-perl/current/ICO/msicon.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/ICO/msicon.c?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/ICO/msicon.c (original)
+++ branches/upstream/libimager-perl/current/ICO/msicon.c Sat Dec 13 01:42:45 2008
@@ -9,6 +9,8 @@
int read_packed(io_glue *ig, const char *format, ...);
static int
read_palette(ico_reader_t *file, ico_image_t *image, int *error);
+static int
+read_24bit_data(ico_reader_t *file, ico_image_t *image, int *error);
static int
read_32bit_data(ico_reader_t *file, ico_image_t *image, int *error);
static int
@@ -256,7 +258,8 @@
return NULL;
}
- if (bit_count != 1 && bit_count != 4 && bit_count != 8 && bit_count != 32) {
+ if (bit_count != 1 && bit_count != 4 && bit_count != 8
+ && bit_count != 24 && bit_count != 32) {
*error = ICOERR_Unknown_Bits;
return 0;
}
@@ -286,6 +289,21 @@
return NULL;
}
if (!read_32bit_data(file, result, error)) {
+ free(result->image_data);
+ free(result);
+ return NULL;
+ }
+ }
+ else if (bit_count == 24) {
+ result->palette_size = 0;
+
+ result->image_data = malloc(result->width * result->height * sizeof(ico_color_t));
+ if (!result->image_data) {
+ free(result);
+ *error = ICOERR_Out_Of_Memory;
+ return NULL;
+ }
+ if (!read_24bit_data(file, result, error)) {
free(result->image_data);
free(result);
return NULL;
@@ -773,6 +791,56 @@
outp->a = inp[3];
++outp;
inp += 4;
+ }
+ }
+ free(buffer);
+
+ return 1;
+}
+
+/*
+=item read_24bit_data
+
+Reads 24 bit image data.
+
+=cut
+*/
+
+static
+int
+read_24bit_data(ico_reader_t *file, ico_image_t *image, int *error) {
+ int line_bytes = image->width * 3;
+ unsigned char *buffer;
+ int y;
+ int x;
+ unsigned char *inp;
+ ico_color_t *outp;
+
+ line_bytes = (line_bytes + 3) / 4 * 4;
+
+ buffer = malloc(line_bytes);
+
+ if (!buffer) {
+ *error = ICOERR_Out_Of_Memory;
+ return 0;
+ }
+
+ for (y = image->height - 1; y >= 0; --y) {
+ if (i_io_read(file->ig, buffer, line_bytes) != line_bytes) {
+ free(buffer);
+ *error = ICOERR_Short_File;
+ return 0;
+ }
+ outp = image->image_data;
+ outp += y * image->width;
+ inp = buffer;
+ for (x = 0; x < image->width; ++x) {
+ outp->b = inp[0];
+ outp->g = inp[1];
+ outp->r = inp[2];
+ outp->a = 255;
+ ++outp;
+ inp += 3;
}
}
free(buffer);
Modified: branches/upstream/libimager-perl/current/ICO/t/t10icon.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/ICO/t/t10icon.t?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/ICO/t/t10icon.t (original)
+++ branches/upstream/libimager-perl/current/ICO/t/t10icon.t Sat Dec 13 01:42:45 2008
@@ -1,6 +1,6 @@
#!perl -w
use strict;
-use Test::More tests => 98;
+use Test::More tests => 100;
use Imager::Test qw(is_image);
BEGIN { use_ok('Imager::File::ICO'); }
@@ -361,3 +361,13 @@
is($im2->type, 'direct', 'expect a direct image');
is_image($im2, $imcopy, 'check against expected');
}
+
+{
+ # read 24-bit images
+ my $im = Imager->new;
+ ok($im->read(file => 'testimg/rgb1616.ico'), "read 24-bit data image")
+ or print "# ", $im->errstr, "\n";
+ my $vs = Imager->new(xsize => 16, ysize => 16);
+ $vs->box(filled => 1, color => '#333366');
+ is_image($im, $vs, "check we got the right colors");
+}
Added: branches/upstream/libimager-perl/current/ICO/testimg/rgb1616.ico
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/ICO/testimg/rgb1616.ico?rev=28152&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libimager-perl/current/ICO/testimg/rgb1616.ico
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Modified: branches/upstream/libimager-perl/current/Imager.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/Imager.pm?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/Imager.pm (original)
+++ branches/upstream/libimager-perl/current/Imager.pm Sat Dec 13 01:42:45 2008
@@ -173,7 +173,7 @@
BEGIN {
require Exporter;
@ISA = qw(Exporter);
- $VERSION = '0.65';
+ $VERSION = '0.67';
eval {
require XSLoader;
XSLoader::load(Imager => $VERSION);
Modified: branches/upstream/libimager-perl/current/Imager.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/Imager.xs?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/Imager.xs (original)
+++ branches/upstream/libimager-perl/current/Imager.xs Sat Dec 13 01:42:45 2008
@@ -719,14 +719,12 @@
sv = hv_fetch(hv, "colors", 6, 0);
if (!sv || !*sv || !SvROK(*sv) || SvTYPE(SvRV(*sv)) != SVt_PVAV) {
- SV *ref;
- av = newAV();
- ref = newRV_inc((SV*) av);
- sv = hv_store(hv, "colors", 6, ref, 0);
+ /* nothing to do */
+ return;
}
- else {
- av = (AV *)SvRV(*sv);
- }
+
+ av = (AV *)SvRV(*sv);
+ av_clear(av);
av_extend(av, quant->mc_count+1);
for (i = 0; i < quant->mc_count; ++i) {
i_color *in = quant->mc_colors+i;
@@ -734,9 +732,7 @@
work = sv_newmortal();
sv_setref_pv(work, "Imager::Color", (void *)c);
SvREFCNT_inc(work);
- if (!av_store(av, i, work)) {
- SvREFCNT_dec(work);
- }
+ av_push(av, work);
}
}
Modified: branches/upstream/libimager-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/MANIFEST?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/MANIFEST (original)
+++ branches/upstream/libimager-perl/current/MANIFEST Sat Dec 13 01:42:45 2008
@@ -40,6 +40,7 @@
ICO/testimg/pal43232.ppm
ICO/testimg/pal83232.ico
ICO/testimg/pal83232.ppm
+ICO/testimg/rgb1616.ico
ICO/testimg/rgba3232.ico
ICO/testimg/rgba3232.ppm
Imager.pm
@@ -268,6 +269,7 @@
t/t80texttools.t Test text wrapping
t/t81hlines.t Test hlines.c
t/t82inline.t Test Inline::C integration
+t/t83extutil.t Test Imager::ExtUtils
t/t90cc.t
t/t91pod.t Test POD with Test::Pod
t/t92samples.t
Modified: branches/upstream/libimager-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/META.yml?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/META.yml (original)
+++ branches/upstream/libimager-perl/current/META.yml Sat Dec 13 01:42:45 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Imager
-version: 0.65
+version: 0.67
version_from: Imager.pm
author:
- Tony Cook <tony at imager.perl.org>
@@ -17,4 +17,4 @@
meta-spec:
version: 1.3
url: http://module-build.sourceforge.net/META-spec-v1.3.html
-generated_by: Imager version 0.65
+generated_by: Imager version 0.67
Modified: branches/upstream/libimager-perl/current/bmp.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/bmp.c?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/bmp.c (original)
+++ branches/upstream/libimager-perl/current/bmp.c Sat Dec 13 01:42:45 2008
@@ -367,7 +367,7 @@
if (!write_packed(ig, "CCVvvVVVVvvVVVVVV", 'B', 'M', data_size+offset,
0, 0, offset, INFOHEAD_SIZE, im->xsize, im->ysize, 1,
- bit_count, BI_RGB, 0, (int)(xres+0.5), (int)(yres+0.5),
+ bit_count, BI_RGB, data_size, (int)(xres+0.5), (int)(yres+0.5),
colors_used, colors_used)){
i_push_error(0, "cannot write bmp header");
return 0;
Modified: branches/upstream/libimager-perl/current/lib/Imager/ExtUtils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/ExtUtils.pm?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/ExtUtils.pm (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/ExtUtils.pm Sat Dec 13 01:42:45 2008
@@ -1,9 +1,10 @@
package Imager::ExtUtils;
use strict;
+use File::Spec;
use vars qw($VERSION);
-$VERSION = "1.001";
+$VERSION = "1.002";
=head1 NAME
@@ -27,9 +28,13 @@
# figure out where Imager is installed
sub base_dir {
- for my $dir (@INC) {
- if (-e "$dir/Imager.pm") {
- return $dir;
+ for my $inc_dir (@INC) {
+ if (-e "$inc_dir/Imager.pm") {
+ my $base_dir = $inc_dir;
+ unless (File::Spec->file_name_is_absolute($base_dir)) {
+ $base_dir = File::Spec->rel2abs($base_dir);
+ }
+ return $base_dir;
}
}
Modified: branches/upstream/libimager-perl/current/lib/Imager/Files.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Files.pod?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Files.pod (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Files.pod Sat Dec 13 01:42:45 2008
@@ -8,10 +8,19 @@
$img->write(file=>$filename, type=>$type)
or die "Cannot write: ",$img->errstr;
+ # type is optional if we can guess the format from the filename
+ $img->write(file => "foo.png")
+ or die "Cannot write: ",$img->errstr;
+
$img = Imager->new;
$img->read(file=>$filename, type=>$type)
or die "Cannot read: ", $img->errstr;
+ # type is optional if we can guess the type from the file data
+ # and we normally can guess
+ $img->read(file => $filename)
+ or die "Cannot read: ", $img->errstr;
+
Imager->write_multi({ file=> $filename, ... }, @images)
or die "Cannot write: ", Imager->errstr;
@@ -22,6 +31,24 @@
my @read_types = Imager->read_types;
my @write_types = Imager->write_types;
+
+ # we can write/write_multi to things other than filenames
+ my $data;
+ $img->write(data => \$data, type => $type) or die;
+
+ my $fh = ... ; # eg. IO::File
+ $img->write(fh => $fh, type => $type) or die;
+
+ $img->write(fd => fileno($fh), type => $type) or die;
+
+ # some file types need seek callbacks too
+ $img->write(callback => \&write_callback, type => $type) or die;
+
+ # and similarly for read/read_multi
+ $img->read(data => $data) or die;
+ $img->read(fh => $fh) or die;
+ $img->read(fd => fileno($fh)) or die;
+ $img->read(callback => \&read_callback) or die;
=head1 DESCRIPTION
@@ -164,7 +191,7 @@
$image->read(file => 'example.tif')
or die $image->errstr;
-=item
+=item *
fh - C<fh> is a file handle, typically either returned from
C<<IO::File->new()>>, or a glob from an C<open> call. You should call
@@ -181,7 +208,7 @@
$image->read(fd => $cgi->param('file'))
or die $image->errstr;
-=item
+=item *
fd - C<fd> is a file descriptor. You can get this by calling the
C<fileno()> function on a file handle, or by using one of the standard
@@ -194,7 +221,7 @@
$image->write(fd => file(STDOUT), type => 'gif')
or die $image->errstr;
-=item
+=item *
data - When reading data, C<data> is a scalar containing the image
file data, when writing, C<data> is a reference to the scalar to save
@@ -725,6 +752,10 @@
C<gif_consolidate> parameter set to a true value:
$img->read(file=>$some_gif_file, gif_consolidate=>1);
+
+As with the to_paletted() method, if you supply a colors parameter as
+a reference to an array, this will be filled with Imager::Color
+objects of the color table generated for the image file.
=head2 TIFF (Tagged Image File Format)
Modified: branches/upstream/libimager-perl/current/lib/Imager/Font/BBox.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Font/BBox.pm?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Font/BBox.pm (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Font/BBox.pm Sat Dec 13 01:42:45 2008
@@ -71,24 +71,53 @@
return $_[0][0];
}
-=item end_offset
-
-=item pos_width
-
-The offset from the selected drawing location to the right edge of the
-last character drawn. Should always be positive.
-
-You can use the alias pos_width() if you are used to the
-bounding_box() documentation for list context.
-
-=cut
-
-sub end_offset {
- return $_[0][2];
-}
-
-sub pos_width {
- return $_[0][2];
+=item advance_width()
+
+The advance width of the string, if the driver supports that,
+otherwise the same as end_offset.
+
+=cut
+
+sub advance_width {
+ my $self = shift;
+
+ @$self > 6 ? $self->[6] : $self->[2];
+}
+
+=item right_bearing
+
+The distance from the right of the last glyph to the end of the advance
+point.
+
+If the glyph overflows the right side of the advance width this value
+is negative.
+
+=cut
+
+sub right_bearing {
+ my $self = shift;
+
+ @$self >= 8 && return $self->[7]; # driver gives it to us
+
+ # otherwise the closest we have is the difference between the
+ # end_pos and advance_width
+ return $self->advance_width - $self->pos_width;
+}
+
+=item display_width
+
+The distance from the left-most pixel of the left-most glyph to the
+right-most pixel of the right-most glyph.
+
+Equals advance_width - left_bearing - right_bearing (and implemented
+that way.)
+
+=cut
+
+sub display_width {
+ my ($self) = @_;
+
+ $self->advance_width - $self->left_bearing - $self->right_bearing;
}
=item global_descent()
@@ -139,23 +168,47 @@
return $_[0][5];
}
-=item advance_width()
-
-The advance width of the string, if the driver supports that,
-otherwise the same as end_offset.
-
-=cut
-
-sub advance_width {
- my $self = shift;
-
- @$self > 6 ? $self->[6] : $self->[2];
-}
+=item font_height()
+
+The maximum displayed height of any string using this font.
+
+=cut
+
+sub font_height {
+ my $self = shift;
+ $self->global_ascent - $self->global_descent;
+}
+
+=item text_height()
+
+The displayed height of the supplied string.
+
+=cut
+
+sub text_height {
+ my $self = shift;
+
+ $self->ascent - $self->descent;
+}
+
+=back
+
+=head1 OBSOLETE METHODS
+
+These methods include bugs kept for backwards compatibility and
+shouldn't be used in new code.
+
+=over
=item total_width()
The total displayed width of the string.
+New code should use display_width().
+
+This depends on end_offset(), and is limited by it's backward
+compatibility.
+
=cut
sub total_width {
@@ -164,63 +217,27 @@
$self->end_offset - $self->start_offset;
}
-=item font_height()
-
-The maximum displayed height of any string using this font.
-
-=cut
-
-sub font_height {
- my $self = shift;
- $self->global_ascent - $self->global_descent;
-}
-
-=item text_height()
-
-The displayed height of the supplied string.
-
-=cut
-
-sub text_height {
- my $self = shift;
-
- $self->ascent - $self->descent;
-}
-
-=item right_bearing
-
-The distance from the right of the last glyph to the end of the advance
-point.
-
-If the glyph overflows the right side of the advance width this value
-is negative.
-
-=cut
-
-sub right_bearing {
- my $self = shift;
-
- @$self >= 8 && return $self->[7]; # driver gives it to us
-
- # otherwise the closest we have is the difference between the
- # end_pos and advance_width
- return $self->advance_width - $self->pos_width;
-}
-
-=item display_width
-
-The distance from the left-most pixel of the left-most glyph to the
-right-most pixel of the right-most glyph.
-
-Equals advance_width - left_bearing - right_bearing (and implemented
-that way.)
-
-=cut
-
-sub display_width {
- my ($self) = @_;
-
- $self->advance_width - $self->left_bearing - $self->right_bearing;
+=item end_offset
+
+=item pos_width
+
+The offset from the selected drawing location to the right edge of the
+last character drawn. Should always be positive.
+
+You can use the alias pos_width() if you are used to the
+bounding_box() documentation for list context.
+
+For backwards compatibility this method returns the maximum of the
+advance width and the offset of the right edge of the last glyph.
+
+=cut
+
+sub end_offset {
+ return $_[0][2];
+}
+
+sub pos_width {
+ return $_[0][2];
}
=back
Modified: branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod Sat Dec 13 01:42:45 2008
@@ -847,7 +847,8 @@
=item colors
A arrayref of colors that are fixed. Note that some color generators
-will ignore this.
+will ignore this. If this is supplied it will be filled with the
+color table generated for the image.
=item transp
@@ -989,8 +990,8 @@
A arrayref containing Imager::Color objects, which represents the
starting set of colors to use in translating the images. webmap will
-ignore this. The final colors used are copied back into this array
-(which is expanded if necessary.)
+ignore this. On return the final colors used are copied back into
+this array (which is expanded if necessary.)
=item max_colors
@@ -1120,7 +1121,7 @@
=head1 REVISION
-$Revision: 1435 $
+$Revision: 1546 $
=head1 AUTHORS
Modified: branches/upstream/libimager-perl/current/rubthru.im
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/rubthru.im?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/rubthru.im (original)
+++ branches/upstream/libimager-perl/current/rubthru.im Sat Dec 13 01:42:45 2008
@@ -121,7 +121,7 @@
ttx = work_left;
IM_GLIN(im, work_left, work_left + work_width, tty, dest_line);
- for(x = src_minx; x < src_maxx; x++) {
+ for(x = min_x; x < max_x; x++) {
src_alpha = srcp->channel[alphachan];
if (src_alpha) {
remains = IM_SAMPLE_MAX - src_alpha;
Modified: branches/upstream/libimager-perl/current/t/t023palette.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t023palette.t?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/t/t023palette.t (original)
+++ branches/upstream/libimager-perl/current/t/t023palette.t Sat Dec 13 01:42:45 2008
@@ -1,10 +1,10 @@
#!perl -w
# some of this is tested in t01introvert.t too
use strict;
-use Test::More tests => 121;
+use Test::More tests => 126;
BEGIN { use_ok("Imager"); }
-use Imager::Test qw(image_bounds_checks);
+use Imager::Test qw(image_bounds_checks test_image is_color3);
sub isbin($$$);
@@ -329,6 +329,20 @@
image_bounds_checks($im);
}
+{ # test colors array returns colors
+ my $data;
+ my $im = test_image();
+ my @colors;
+ my $imp = $im->to_paletted(colors => \@colors,
+ make_colors => 'webmap',
+ translate => 'closest');
+ ok($imp, "made paletted");
+ is(@colors, 216, "should be 216 colors in the webmap");
+ is_color3($colors[0], 0, 0, 0, "first should be 000000");
+ is_color3($colors[1], 0, 0, 0x33, "second should be 000033");
+ is_color3($colors[8], 0, 0x33, 0x66, "9th should be 003366");
+}
+
sub iscolor {
my ($c1, $c2, $msg) = @_;
Modified: branches/upstream/libimager-perl/current/t/t105gif.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t105gif.t?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/t/t105gif.t (original)
+++ branches/upstream/libimager-perl/current/t/t105gif.t Sat Dec 13 01:42:45 2008
@@ -12,9 +12,9 @@
use strict;
$|=1;
-use Test::More tests => 140;
+use Test::More tests => 145;
use Imager qw(:all);
-use Imager::Test qw(is_color3);
+use Imager::Test qw(is_color3 test_image);
use Carp 'confess';
$SIG{__DIE__} = sub { confess @_ };
@@ -51,7 +51,7 @@
cmp_ok($im->errstr, '=~', "format 'gif' not supported", "check no gif message");
ok(!grep($_ eq 'gif', Imager->read_types), "check gif not in read types");
ok(!grep($_ eq 'gif', Imager->write_types), "check gif not in write types");
- skip("no gif support", 134);
+ skip("no gif support", 139);
}
open(FH,">testout/t105.gif") || die "Cannot open testout/t105.gif\n";
binmode(FH);
@@ -742,6 +742,23 @@
is($result[1]->tags(name => 'gif_top'), 0,
"check second gif_top");
}
+
+ { # test colors array returns colors
+ my $data;
+ my $im = test_image();
+ my @colors;
+ ok($im->write(data => \$data,
+ colors => \@colors,
+ make_colors => 'webmap',
+ translate => 'closest',
+ gifquant => 'gen',
+ type => 'gif'),
+ "write using webmap to check color table");
+ is(@colors, 216, "should be 216 colors in the webmap");
+ is_color3($colors[0], 0, 0, 0, "first should be 000000");
+ is_color3($colors[1], 0, 0, 0x33, "second should be 000033");
+ is_color3($colors[8], 0, 0x33, 0x66, "9th should be 003366");
+ }
}
sub test_readgif_cb {
Modified: branches/upstream/libimager-perl/current/t/t107bmp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t107bmp.t?rev=28152&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/t/t107bmp.t (original)
+++ branches/upstream/libimager-perl/current/t/t107bmp.t Sat Dec 13 01:42:45 2008
@@ -1,8 +1,8 @@
#!perl -w
use strict;
-use Test::More tests => 211;
+use Test::More tests => 213;
use Imager qw(:all);
-use Imager::Test qw(test_image_raw is_image is_color3);
+use Imager::Test qw(test_image_raw is_image is_color3 test_image);
init_log("testout/t107bmp.log",1);
my $debug_writes = 0;
@@ -645,6 +645,14 @@
"check color came through");
is_color3($imread->getpixel('x' => 0, 'y' => 15), 127, 96, 96,
"check translucent came through");
+}
+
+{ # RT 41406
+ my $data;
+ my $im = test_image();
+ ok($im->write(data => \$data, type => 'bmp'), "write using OO");
+ my $size = unpack("V", substr($data, 34, 4));
+ is($size, 67800, "check data size");
}
sub write_test {
Added: branches/upstream/libimager-perl/current/t/t83extutil.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t83extutil.t?rev=28152&op=file
==============================================================================
--- branches/upstream/libimager-perl/current/t/t83extutil.t (added)
+++ branches/upstream/libimager-perl/current/t/t83extutil.t Sat Dec 13 01:42:45 2008
@@ -1,0 +1,32 @@
+#!perl -w
+use strict;
+use Test::More tests => 6;
+use File::Spec;
+
+{ # RT 37353
+ local @INC = @INC;
+
+ unshift @INC, File::Spec->catdir('blib', 'lib');
+ unshift @INC, File::Spec->catdir('blib', 'arch');
+ require Imager::ExtUtils;
+ my $path = Imager::ExtUtils->base_dir;
+ ok(File::Spec->file_name_is_absolute($path), "check dirs absolute")
+ or print "# $path\n";
+}
+
+{ # includes
+ my $includes = Imager::ExtUtils->includes;
+ ok($includes =~ s/^-I//, "has the -I");
+ ok(-e File::Spec->catfile($includes, "imext.h"), "found a header");
+}
+
+{ # typemap
+ my $typemap = Imager::ExtUtils->typemap;
+ ok($typemap, "got a typemap path");
+ ok(-f $typemap, "it exists");
+ open TYPEMAP, "< $typemap";
+ my $tm_content = do { local $/; <TYPEMAP>; };
+ close TYPEMAP;
+ cmp_ok($tm_content, '=~', "Imager::Color\\s+T_PTROBJ",
+ "it seems to be the right file");
+}
More information about the Pkg-perl-cvs-commits
mailing list