r75497 - in /trunk/libimager-perl: ./ T1/ TIFF/t/ debian/ lib/Imager/ t/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Sun Jun 12 13:08:32 UTC 2011
Author: periapt-guest
Date: Sun Jun 12 13:08:23 2011
New Revision: 75497
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=75497
Log:
New upstream release
Added:
trunk/libimager-perl/T1/README
- copied unchanged from r75496, branches/upstream/libimager-perl/current/T1/README
trunk/libimager-perl/t/t62compose.t
- copied unchanged from r75496, branches/upstream/libimager-perl/current/t/t62compose.t
Modified:
trunk/libimager-perl/Changes
trunk/libimager-perl/Imager.pm
trunk/libimager-perl/Imager.xs
trunk/libimager-perl/MANIFEST
trunk/libimager-perl/MANIFEST.SKIP
trunk/libimager-perl/META.yml
trunk/libimager-perl/T1/T1.pm
trunk/libimager-perl/TIFF/t/t10tiff.t
trunk/libimager-perl/compose.im
trunk/libimager-perl/debian/changelog
trunk/libimager-perl/draw.c
trunk/libimager-perl/image.c
trunk/libimager-perl/imager.h
trunk/libimager-perl/lib/Imager/LargeSamples.pod
trunk/libimager-perl/lib/Imager/Preprocess.pm
trunk/libimager-perl/lib/Imager/Test.pm
Modified: trunk/libimager-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/Changes?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/Changes (original)
+++ trunk/libimager-perl/Changes Sun Jun 12 13:08:23 2011
@@ -1,4 +1,34 @@
Imager release history. Older releases can be found in Changes.old
+
+Imager 0.83 - 21 May 2011
+===========
+
+Bug fixes:
+
+ - diag() the error message on failure for some TIFF tests that are
+ failing on a Solaris smoker.
+ http://www.cpantesters.org/cpan/report/6396db1e-8090-11e0-9682-112b785ebe45
+
+Imager 0.82_01 - 17 May 2011
+==============
+
+Dev release, in case the compose tests are too sensitive.
+
+Bug fixes:
+
+ - Imager::Font::T1 incorrectly checked for absolute filename under
+ Win32. Thanks to kmx for the report and fix.
+ https://rt.cpan.org/Ticket/Display.html?id=67963
+
+ - compose() with the target, source or mask position off the top or
+ left of the target image didn't clip the source image correctly.
+ https://rt.cpan.org/Ticket/Display.html?id=67220
+
+ - compose() now returns a useful error message on a non-positive
+ opacity.
+
+ - compose.im now at 100% test coverage. (As opposed to, umm, much,
+ much less.)
Imager 0.82 - 14 Mar 2011
===========
Modified: trunk/libimager-perl/Imager.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/Imager.pm?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/Imager.pm (original)
+++ trunk/libimager-perl/Imager.pm Sun Jun 12 13:08:23 2011
@@ -146,7 +146,7 @@
BEGIN {
require Exporter;
@ISA = qw(Exporter);
- $VERSION = '0.82';
+ $VERSION = '0.83';
eval {
require XSLoader;
XSLoader::load(Imager => $VERSION);
@@ -2501,16 +2501,20 @@
defined $mask_top or $mask_top = $opts{mask_miny};
defined $mask_top or $mask_top = 0;
- i_compose_mask($self->{IMG}, $src->{IMG}, $opts{mask}{IMG},
+ unless (i_compose_mask($self->{IMG}, $src->{IMG}, $opts{mask}{IMG},
$left, $top, $src_left, $src_top,
$mask_left, $mask_top, $width, $height,
- $combine, $opts{opacity})
- or return;
+ $combine, $opts{opacity})) {
+ $self->_set_error(Imager->_error_as_msg);
+ return;
+ }
}
else {
- i_compose($self->{IMG}, $src->{IMG}, $left, $top, $src_left, $src_top,
- $width, $height, $combine, $opts{opacity})
- or return;
+ unless (i_compose($self->{IMG}, $src->{IMG}, $left, $top, $src_left, $src_top,
+ $width, $height, $combine, $opts{opacity})) {
+ $self->_set_error(Imager->_error_as_msg);
+ return;
+ }
}
return $self;
@@ -2681,7 +2685,12 @@
$color = i_color_new(255,255,255,255);
}
- i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color);
+ if ($color->isa("Imager::Color")) {
+ i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color);
+ }
+ else {
+ i_box_filledf($raw, $xmin, $ymin,$xmax, $ymax, $color);
+ }
}
elsif ($opts{fill}) {
unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
Modified: trunk/libimager-perl/Imager.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/Imager.xs?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/Imager.xs (original)
+++ trunk/libimager-perl/Imager.xs Sun Jun 12 13:08:23 2011
@@ -20,6 +20,7 @@
#include "regmach.h"
#include "imextdef.h"
#include "imextpltypes.h"
+#include <float.h>
#if i_int_hlines_testing()
#include "imageri.h"
@@ -954,6 +955,8 @@
#define i_img_get_width(im) ((im)->xsize)
#define i_img_get_height(im) ((im)->ysize)
+#define i_img_epsilonf() (DBL_EPSILON * 4)
+
MODULE = Imager PACKAGE = Imager::Color PREFIX = ICL_
Imager::Color
@@ -1449,6 +1452,15 @@
int x2
int y2
Imager::Color val
+
+int
+i_box_filledf(im,x1,y1,x2,y2,val)
+ Imager::ImgRaw im
+ int x1
+ int y1
+ int x2
+ int y2
+ Imager::Color::Float val
void
i_box_cfill(im,x1,y1,x2,y2,fill)
@@ -2001,6 +2013,16 @@
i_img_diffd(im1,im2)
Imager::ImgRaw im1
Imager::ImgRaw im2
+
+int
+i_img_samef(im1, im2, epsilon = i_img_epsilonf(), what=NULL)
+ Imager::ImgRaw im1
+ Imager::ImgRaw im2
+ double epsilon
+ const char *what
+
+double
+i_img_epsilonf()
bool
_is_color_object(sv)
Modified: trunk/libimager-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/MANIFEST?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/MANIFEST (original)
+++ trunk/libimager-perl/MANIFEST Sun Jun 12 13:08:23 2011
@@ -306,6 +306,7 @@
t/t58trans2.t
t/t59assem.t
t/t61filters.t
+t/t62compose.t
t/t63combine.t Test combine() method
t/t64copyflip.t Test copy, flip, rotate, matrix_transform
t/t65crop.t
@@ -335,6 +336,7 @@
T1/imt1.c
T1/imt1.h
T1/Makefile.PL
+T1/README
T1/t/t10type1.t
T1/t/t20oo.t
T1/T1.pm
Modified: trunk/libimager-perl/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/MANIFEST.SKIP?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/MANIFEST.SKIP (original)
+++ trunk/libimager-perl/MANIFEST.SKIP Sun Jun 12 13:08:23 2011
@@ -78,6 +78,7 @@
^T1/T1\.c$
^.*/Changes$
+^.*/MANIFEST(\.SKIP)?$
^blib/
^Flines/Flines\.c$
^Imager\.c$
Modified: trunk/libimager-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/META.yml?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/META.yml (original)
+++ trunk/libimager-perl/META.yml Sun Jun 12 13:08:23 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Imager
-version: 0.82
+version: 0.83
abstract: Perl extension for Generating 24 bit Images
author:
- Tony Cook <tony at imager.perl.org>, Arnar M. Hrafnkelsson
Modified: trunk/libimager-perl/T1/T1.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/T1/T1.pm?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/T1/T1.pm (original)
+++ trunk/libimager-perl/T1/T1.pm Sun Jun 12 13:08:23 2011
@@ -5,7 +5,7 @@
@ISA = qw(Imager::Font);
BEGIN {
- $VERSION = "1.011";
+ $VERSION = "1.012";
eval {
require XSLoader;
@@ -54,7 +54,7 @@
# we want to avoid T1Lib's file search mechanism
unless ($hsh{file} =~ m!^/!
|| $hsh{file} =~ m!^\.\/?/!
- || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/) {
+ || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
$hsh{file} = './' . $hsh{file};
}
@@ -65,7 +65,7 @@
}
unless ($hsh{afm} =~ m!^/!
|| $hsh{afm} =~ m!^\./!
- || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/) {
+ || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
$hsh{file} = './' . $hsh{file};
}
} else {
Modified: trunk/libimager-perl/TIFF/t/t10tiff.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/TIFF/t/t10tiff.t?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/TIFF/t/t10tiff.t (original)
+++ trunk/libimager-perl/TIFF/t/t10tiff.t Sun Jun 12 13:08:23 2011
@@ -309,17 +309,21 @@
# correctly on read
@imgs = map $ooim->copy(), 1..40;
$rc = Imager->write_multi({file=>'testout/t106_multi2.tif'}, @imgs);
-ok($rc, "writing 40 images to tiff");
+ok($rc, "writing 40 images to tiff")
+ or diag("writing 40 images: " . Imager->errstr);
@out = Imager->read_multi(file=>'testout/t106_multi2.tif');
-ok(@imgs == @out, "reading 40 images from tiff");
+ok(@imgs == @out, "reading 40 images from tiff")
+ or diag("reading 40 images:" . Imager->errstr);
# force some allocation activity - helps crash here if it's the problem
@out = @imgs = ();
# multi-image fax files
ok(Imager->write_multi({file=>'testout/t106_faxmulti.tiff', class=>'fax'},
- $oofim, $oofim), "write multi fax image");
+ $oofim, $oofim), "write multi fax image")
+ or diag("writing 40 fax pages: " . Imager->errstr);
@imgs = Imager->read_multi(file=>'testout/t106_faxmulti.tiff');
-ok(@imgs == 2, "reading multipage fax");
+ok(@imgs == 2, "reading multipage fax")
+ or diag("reading 40 fax pages: " . Imager->errstr);
ok(Imager::i_img_diff($imgs[0]{IMG}, $oofim->{IMG}) == 0,
"compare first fax image");
ok(Imager::i_img_diff($imgs[1]{IMG}, $oofim->{IMG}) == 0,
Modified: trunk/libimager-perl/compose.im
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/compose.im?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/compose.im (original)
+++ trunk/libimager-perl/compose.im Sun Jun 12 13:08:23 2011
@@ -15,6 +15,11 @@
i_fill_combine_f combinef_8;
i_fill_combinef_f combinef_double;
int channel_zero = 0;
+
+ mm_log((1, "i_compose_mask(out %p, src %p, mask %p, out(%d, %d), src(%d, %d),"
+ " mask(%d,%d), size(%d,%d), combine %d opacity %f\n", out, src,
+ mask, out_left, out_top, src_left, src_top, mask_left, mask_top, width,
+ height, combine, opacity));
i_clear_error();
if (out_left >= out->xsize
@@ -35,6 +40,8 @@
if (out_left < 0) {
width = out_left + width;
+ src_left -= out_left;
+ mask_left -= out_left;
out_left = 0;
}
if (out_left + width > out->xsize)
@@ -42,6 +49,8 @@
if (out_top < 0) {
height = out_top + height;
+ mask_top -= out_top;
+ src_top -= out_top;
out_top = 0;
}
if (out_top + height > out->ysize)
@@ -49,6 +58,8 @@
if (src_left < 0) {
width = src_left + width;
+ out_left -= src_left;
+ mask_left -= src_left;
src_left = 0;
}
if (src_left + width > src->xsize)
@@ -56,29 +67,42 @@
if (src_top < 0) {
height = src_top + height;
+ out_top -= src_top;
+ mask_top -= src_top;
src_top = 0;
}
if (src_top + height > src->ysize)
- height = src->ysize - src_left;
+ height = src->ysize - src_top;
if (mask_left < 0) {
width = mask_left + width;
+ out_left -= mask_left;
+ src_left -= mask_left;
mask_left = 0;
}
if (mask_left + width > mask->xsize)
width = mask->xsize - mask_left;
if (mask_top < 0) {
- height = mask->ysize + height;
+ height = mask_top + height;
+ src_top -= mask_top;
+ out_top -= mask_top;
mask_top = 0;
}
if (mask_top + height > mask->ysize)
- height = mask->xsize - mask_top;
+ height = mask->ysize - mask_top;
if (opacity > 1.0)
opacity = 1.0;
- else if (opacity <= 0)
- return 0;
+ else if (opacity <= 0) {
+ i_push_error(0, "opacity must be positive");
+ return 0;
+ }
+
+ mm_log((1, "after adjustments: (out(%d, %d), src(%d, %d),"
+ " mask(%d,%d), size(%d,%d)\n",
+ out_left, out_top, src_left, src_top, mask_left, mask_top, width,
+ height));
i_get_combine(combine, &combinef_8, &combinef_double);
@@ -128,6 +152,10 @@
i_fill_combine_f combinef_8;
i_fill_combinef_f combinef_double;
+ mm_log((1, "i_compose(out %p, src %p, out(%d, %d), src(%d, %d), size(%d,%d),"
+ " combine %d opacity %f\n", out, src, out_left, out_top,
+ src_left, src_top, width, height, combine, opacity));
+
i_clear_error();
if (out_left >= out->xsize
|| out_top >= out->ysize
@@ -143,6 +171,7 @@
if (out_left < 0) {
width = out_left + width;
+ src_left -= out_left;
out_left = 0;
}
if (out_left + width > out->xsize)
@@ -150,6 +179,7 @@
if (out_top < 0) {
height = out_top + height;
+ src_top -= out_top;
out_top = 0;
}
if (out_top + height > out->ysize)
@@ -157,6 +187,7 @@
if (src_left < 0) {
width = src_left + width;
+ out_left -= src_left;
src_left = 0;
}
if (src_left + width > src->xsize)
@@ -164,15 +195,18 @@
if (src_top < 0) {
height = src_top + height;
+ out_top -= src_top;
src_top = 0;
}
if (src_top + height > src->ysize)
- height = src->ysize - src_left;
+ height = src->ysize - src_top;
if (opacity > 1.0)
opacity = 1.0;
- else if (opacity <= 0)
- return 0;
+ else if (opacity <= 0) {
+ i_push_error(0, "opacity must be positive");
+ return 0;
+ }
i_get_combine(combine, &combinef_8, &combinef_double);
Modified: trunk/libimager-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/debian/changelog?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/debian/changelog (original)
+++ trunk/libimager-perl/debian/changelog Sun Jun 12 13:08:23 2011
@@ -1,3 +1,9 @@
+libimager-perl (0.83+dfsg-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Nicholas Bamber <nicholas at periapt.co.uk> Sun, 12 Jun 2011 14:11:40 +0100
+
libimager-perl (0.82+dfsg-1) unstable; urgency=low
* New upstream release
Modified: trunk/libimager-perl/draw.c
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/draw.c?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/draw.c (original)
+++ trunk/libimager-perl/draw.c Sun Jun 12 13:08:23 2011
@@ -1123,6 +1123,65 @@
}
/*
+=item i_box_filledf(im, x1, y1, x2, y2, color)
+
+=category Drawing
+=synopsis i_box_filledf(im, 0, 0, im->xsize-1, im->ysize-1, &fcolor);
+
+Fills the box from (x1,y1) to (x2,y2) inclusive with a floating point
+color.
+
+=cut
+*/
+
+int
+i_box_filledf(i_img *im,int x1,int y1,int x2,int y2, const i_fcolor *val) {
+ i_img_dim x, y, width;
+ i_palidx index;
+
+ mm_log((1,"i_box_filledf(im* 0x%x,x1 %d,y1 %d,x2 %d,y2 %d,val 0x%x)\n",im,x1,y1,x2,y2,val));
+
+ if (x1 > x2 || y1 > y2
+ || x2 < 0 || y2 < 0
+ || x1 >= im->xsize || y1 > im->ysize)
+ return 0;
+
+ if (x1 < 0)
+ x1 = 0;
+ if (x2 >= im->xsize)
+ x2 = im->xsize - 1;
+ if (y1 < 0)
+ y1 = 0;
+ if (y2 >= im->ysize)
+ y2 = im->ysize - 1;
+
+ width = x2 - x1 + 1;
+
+ if (im->bits <= 8) {
+ i_color c;
+ c.rgba.r = SampleFTo8(val->rgba.r);
+ c.rgba.g = SampleFTo8(val->rgba.g);
+ c.rgba.b = SampleFTo8(val->rgba.b);
+ c.rgba.a = SampleFTo8(val->rgba.a);
+
+ i_box_filled(im, x1, y1, x2, y2, &c);
+ }
+ else {
+ i_fcolor *line = mymalloc(sizeof(i_fcolor) * width);
+
+ for (x = 0; x < width; ++x)
+ line[x] = *val;
+
+ for (y = y1; y <= y2; ++y)
+ i_plinf(im, x1, x2+1, y, line);
+
+ myfree(line);
+ }
+
+ return 1;
+}
+
+/*
=item i_box_cfill(im, x1, y1, x2, y2, fill)
=category Drawing
Modified: trunk/libimager-perl/image.c
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/image.c?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/image.c (original)
+++ trunk/libimager-perl/image.c Sun Jun 12 13:08:23 2011
@@ -1165,7 +1165,7 @@
yb=(im1->ysize<im2->ysize)?im1->ysize:im2->ysize;
chb=(im1->channels<im2->channels)?im1->channels:im2->channels;
- mm_log((1,"i_img_diff: xb=%d xy=%d chb=%d\n",xb,yb,chb));
+ mm_log((1,"i_img_diffd: xb=%d xy=%d chb=%d\n",xb,yb,chb));
tdiff=0;
for(y=0;y<yb;y++) for(x=0;x<xb;x++) {
@@ -1180,6 +1180,41 @@
mm_log((1,"i_img_diffd <- (%.2f)\n",tdiff));
return tdiff;
+}
+
+int
+i_img_samef(i_img *im1,i_img *im2, double epsilon, char const *what) {
+ int x,y,ch,xb,yb,chb;
+ i_fcolor val1,val2;
+
+ if (what == NULL)
+ what = "(null)";
+
+ mm_log((1,"i_img_samef(im1 0x%x,im2 0x%x, epsilon %g, what '%s')\n", im1, im2, epsilon, what));
+
+ xb=(im1->xsize<im2->xsize)?im1->xsize:im2->xsize;
+ yb=(im1->ysize<im2->ysize)?im1->ysize:im2->ysize;
+ chb=(im1->channels<im2->channels)?im1->channels:im2->channels;
+
+ mm_log((1,"i_img_samef: xb=%d xy=%d chb=%d\n",xb,yb,chb));
+
+ for(y = 0; y < yb; y++) {
+ for(x = 0; x < xb; x++) {
+ i_gpixf(im1, x, y, &val1);
+ i_gpixf(im2, x, y, &val2);
+
+ for(ch = 0; ch < chb; ch++) {
+ double sdiff = val1.channel[ch] - val2.channel[ch];
+ if (fabs(sdiff) > epsilon) {
+ mm_log((1,"i_img_samef <- different %g @(%d,%d)\n", sdiff, x, y));
+ return 0;
+ }
+ }
+ }
+ }
+ mm_log((1,"i_img_samef <- same\n"));
+
+ return 1;
}
/* just a tiny demo of haar wavelets */
Modified: trunk/libimager-perl/imager.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/imager.h?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/imager.h (original)
+++ trunk/libimager-perl/imager.h Sun Jun 12 13:08:23 2011
@@ -164,6 +164,7 @@
void i_box (i_img *im,int x1,int y1,int x2,int y2,const i_color *val);
void i_box_filled (i_img *im,int x1,int y1,int x2,int y2,const i_color *val);
+int i_box_filledf (i_img *im,int x1,int y1,int x2,int y2,const i_fcolor *val);
void i_box_cfill(i_img *im, int x1, int y1, int x2, int y2, i_fill_t *fill);
void i_line (i_img *im,int x1,int y1,int x2,int y2,const i_color *val, int endp);
void i_line_aa (i_img *im,int x1,int y1,int x2,int y2,const i_color *val, int endp);
@@ -222,6 +223,7 @@
float i_img_diff (i_img *im1,i_img *im2);
double i_img_diffd(i_img *im1,i_img *im2);
+int i_img_samef(i_img *im1,i_img *im2, double epsilon, const char *what);
/* font routines */
Modified: trunk/libimager-perl/lib/Imager/LargeSamples.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/lib/Imager/LargeSamples.pod?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/lib/Imager/LargeSamples.pod (original)
+++ trunk/libimager-perl/lib/Imager/LargeSamples.pod Sun Jun 12 13:08:23 2011
@@ -26,7 +26,7 @@
Method Support Notes
------ ------- -----
arc Partial [1]
- box Partial [1]
+ box Partial [2]
circle Partial [1]
convert Full
copy Full
@@ -63,6 +63,9 @@
[1] filling an area using the fill parameter works at the full depth
of the image, using filled => 1 and color works at 8-bits/sample
+
+[2] box() will fill the area at the supplied color, but outline at
+8-bits/sample.
=head1 File format large sample support
Modified: trunk/libimager-perl/lib/Imager/Preprocess.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/lib/Imager/Preprocess.pm?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/lib/Imager/Preprocess.pm (original)
+++ trunk/libimager-perl/lib/Imager/Preprocess.pm Sun Jun 12 13:08:23 2011
@@ -2,14 +2,22 @@
use strict;
require Exporter;
use vars qw(@ISA @EXPORT $VERSION);
+use Getopt::Long;
+use Text::ParseWords;
@EXPORT = qw(preprocess);
@ISA = qw(Exporter);
$VERSION = "1.000";
-
sub preprocess {
+ unshift @ARGV, grep /^-/, shellwords($ENV{IMAGER_PREPROCESS_OPTS})
+ if $ENV{IMAGER_PREPROCESS_OPTS};
+ my $skip_lines = 0;
+ GetOptions("l" => \$skip_lines)
+ or usage();
+ my $keep_lines = !$skip_lines;
+
my $src = shift @ARGV;
my $dest = shift @ARGV
or usage();
@@ -29,8 +37,8 @@
"#define IM_ROUND_8(x) ((int)((x)+0.5))\n",
"#define IM_ROUND_double(x) (x)\n",
"#define IM_LIMIT_8(x) ((x) < 0 ? 0 : (x) > 255 ? 255 : (x))\n",
- "#define IM_LIMIT_double(x) ((x) < 0.0 ? 0.0 : (x) > 1.0 ? 1.0 : (x))\n",
- "#line 1 \"$src\"\n";
+ "#define IM_LIMIT_double(x) ((x) < 0.0 ? 0.0 : (x) > 1.0 ? 1.0 : (x))\n";
+ push @out, "#line 1 \"$src\"\n" if $keep_lines;
while (defined(my $line = <SRC>)) {
if ($line =~ /^\#code\s+(\S.+)$/) {
$save_code
@@ -55,7 +63,7 @@
or do { warn "$src:$.:#/code without #code\n"; ++$failed; next; };
if ($cond) {
- push @out, "#line $cond_line \"$src\"\n";
+ push @out, "#line $cond_line \"$src\"\n" if $keep_lines;
push @out, " if ($cond) {\n";
}
push @out,
@@ -65,7 +73,7 @@
"#define IM_FILL_COMBINE(fill) ((fill)->combine)\n",
"#undef IM_FILL_FILLER\n",
"#define IM_FILL_FILLER(fill) ((fill)->f_fill_with_color)\n";
- push @out, "#line $code_line \"$src\"\n";
+ push @out, "#line $code_line \"$src\"\n" if $keep_lines;
push @out, byte_samples(@code);
push @out, " }\n", " else {\n"
if $cond;
@@ -75,11 +83,11 @@
"#define IM_FILL_COMBINE(fill) ((fill)->combinef)\n",
"#undef IM_FILL_FILLER\n",
"#define IM_FILL_FILLER(fill) ((fill)->f_fill_with_fcolor)\n";
- push @out, "#line $code_line \"$src\"\n";
+ push @out, "#line $code_line \"$src\"\n" if $keep_lines;
push @out, double_samples(@code);
push @out, " }\n"
if $cond;
- push @out, "#line ",$.+1," \"$src\"\n";
+ push @out, "#line ",$.+1," \"$src\"\n" if $keep_lines;
@code = ();
$save_code = 0;
}
@@ -163,6 +171,17 @@
@lines;
}
+sub usage {
+ die <<EOS;
+Usage: perl -MImager::Preprocess -epreprocess [-l] infile outfile
+ -l don't produce #line directives
+ infile - input file
+ outfile output file
+
+See perldoc Imager::Preprocess for details.
+EOS
+}
+
1;
__END__
@@ -180,7 +199,11 @@
... code using preprocessor types/values ...
#/code
- perl -MImager -epreprocess foo.im foo.c
+ # process and make #line directives
+ perl -MImager::Preprocess -epreprocess foo.im foo.c
+
+ # process and no #line directives
+ perl -MImager::Preprocess -epreprocess -l foo.im foo.c
=head1 DESCRIPTION
Modified: trunk/libimager-perl/lib/Imager/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/lib/Imager/Test.pm?rev=75497&op=diff
==============================================================================
--- trunk/libimager-perl/lib/Imager/Test.pm (original)
+++ trunk/libimager-perl/lib/Imager/Test.pm Sun Jun 12 13:08:23 2011
@@ -436,6 +436,11 @@
}
sub is_imaged($$$) {
+ my $epsilon = Imager::i_img_epsilonf();
+ if (@_ > 3) {
+ ($epsilon) = splice @_, 2, 1;
+ }
+
my ($left, $right, $comment) = @_;
{
@@ -447,17 +452,17 @@
my $builder = Test::Builder->new;
- my $diff = Imager::i_img_diffd($left->{IMG}, $right->{IMG});
- if ($diff > 0) {
- $builder->ok(0, $comment);
- $builder->diag("image data difference: $diff");
-
+ my $same = Imager::i_img_samef($left->{IMG}, $right->{IMG}, $epsilon, $comment);
+ if (!$same) {
+ $builder->ok(0, $comment);
+ $builder->diag("images different");
+
# find the first mismatch
PIXELS:
for my $y (0 .. $left->getheight()-1) {
for my $x (0.. $left->getwidth()-1) {
- my @lsamples = $left->getsamples(x => $x, y => $y, width => 1);
- my @rsamples = $right->getsamples(x => $x, y => $y, width => 1);
+ my @lsamples = $left->getsamples(x => $x, y => $y, width => 1, type => "float");
+ my @rsamples = $right->getsamples(x => $x, y => $y, width => 1, type => "float");
if ("@lsamples" ne "@rsamples") {
$builder->diag("first mismatch at ($x, $y) - @lsamples vs @rsamples");
last PIXELS;
@@ -732,8 +737,11 @@
=item is_imaged($im, $im2, $comment)
+=item is_imaged($im, $im2, $epsilon, $comment)
+
Tests if the two images have the same content at the double/sample
-level.
+level. C<$epsilon> defaults to the platform DBL_EPSILON multiplied by
+four.
=item is_image_similar($im1, $im2, $maxdiff, $comment)
More information about the Pkg-perl-cvs-commits
mailing list