require Exporter;
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
-@EXPORT_OK = qw(diff_text_with_nul
- test_image_raw test_image_16 test_image test_image_double
- is_color3 is_color1 is_color4 is_color_close3
- is_fcolor4
- is_image is_image_similar
- image_bounds_checks mask_tests
- test_colorf_gpix test_color_gpix test_colorf_glin);
+@EXPORT_OK =
+ qw(
+ diff_text_with_nul
+ test_image_raw
+ test_image_16
+ test_image
+ test_image_double
+ is_color1
+ is_color3
+ is_color4
+ is_color_close3
+ is_fcolor4
+ color_cmp
+ is_image
+ is_image_similar
+ image_bounds_checks
+ mask_tests
+ test_colorf_gpix
+ test_color_gpix
+ test_colorf_glin);
sub diff_text_with_nul {
my ($desc, $text1, $text2, @params) = @_;
$builder->ok(0, "$comment - retrieve color at ($x,$y)");
return;
}
- unless ($builder->ok(_colorf_cmp($c, $expected, $epsilon) == 0,
+ unless ($builder->ok(colorf_cmp($c, $expected, $epsilon) == 0,
"$comment - got right color ($x, $y)")) {
- print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
- print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
- return;
+ my @c = $c->rgba;
+ my @exp = $expected->rgba;
+ $builder->diag(<<EOS);
+# got: ($c[0], $c[1], $c[2])
+# expected: ($exp[0], $exp[1], $exp[2])
+EOS
}
1;
}
$builder->ok(0, "$comment - retrieve color at ($x,$y)");
return;
}
- unless ($builder->ok(_color_cmp($c, $expected) == 0,
+ unless ($builder->ok(color_cmp($c, $expected) == 0,
"got right color ($x, $y)")) {
- print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
- print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
+ my @c = $c->rgba;
+ my @exp = $expected->rgba;
+ $builder->diag(<<EOS);
+# got: ($c[0], $c[1], $c[2])
+# expected: ($exp[0], $exp[1], $exp[2])
+EOS
return;
}
@got == @$pels
or return $builder->is_num(scalar(@got), scalar(@$pels), "$comment - pixels retrieved");
- return $builder->ok(!grep(_colorf_cmp($pels->[$_], $got[$_], 0.005), 0..$#got),
+ return $builder->ok(!grep(colorf_cmp($pels->[$_], $got[$_], 0.005), 0..$#got),
"$comment - check colors ($x, $y)");
}
-sub _colorf_cmp {
+sub colorf_cmp {
my ($c1, $c2, $epsilon) = @_;
defined $epsilon or $epsilon = 0;
|| abs($s1[2]-$s2[2]) >= $epsilon && $s1[2] <=> $s2[2];
}
-sub _color_cmp {
+sub color_cmp {
my ($c1, $c2) = @_;
my @s1 = $c1->rgba;
# to make sure we get expected values
use strict;
-use Test::More tests => 228;
+use Test::More tests => 220;
BEGIN { use_ok(Imager => qw(:handy :all)) }
-require "t/testtools.pl";
-
-use Imager::Test qw(image_bounds_checks is_color4 is_fcolor4);
+use Imager::Test qw(image_bounds_checks is_color3 is_color4 is_fcolor4 color_cmp mask_tests);
init_log("testout/t01introvert.log",1);
# reading indicies as colors
my $c_red = Imager::i_get_pixel($im_pal, 0, 0);
ok($c_red, "got the red pixel");
-ok(color_cmp($red, $c_red) == 0, "and it's red");
+is_color3($c_red, 255, 0, 0, "and it's red");
my $c_blue = Imager::i_get_pixel($im_pal, 50, 0);
ok($c_blue, "got the blue pixel");
-ok(color_cmp($blue, $c_blue) == 0, "and it's blue");
+is_color3($c_blue, 0, 0, 255, "and it's blue");
# drawing with colors
ok(Imager::i_ppix($im_pal, 0, 0, $green) == 0, "draw with color in palette");
my $c_green = Imager::i_get_pixel($im_pal, 0, 0);
ok($c_green, "got green pixel");
-ok(color_cmp($green, $c_green) == 0, "and it's green");
+is_color3($c_green, 0, 255, 0, "and it's green");
is(Imager::i_colorcount($im_pal), 3, "still 3 colors in palette");
is(Imager::i_findcolor($im_pal, $green), 1, "and green is the second");
is($blue_idx, 1, "and it's expected index for blue");
my $green_idx = $blue_idx + 1;
my $c = $impal2->getcolors(start=>$green_idx);
- ok(color_cmp($green, $c) == 0, "found green where expected");
+ is_color3($c, 0, 255, 0, "found green where expected");
my @cols = $impal2->getcolors;
is(@cols, 3, "got 3 colors");
my @exp = ( $red, $blue, $green );
my @row = Imager::i_glin($im->{IMG}, 0, 2, 0);
is(@row, 2, "got 2 pixels from i_glin");
- ok(color_cmp($row[0], $red) == 0, "red first");
- ok(color_cmp($row[1], $blue) == 0, "then blue");
+ is_color3($row[0], 255, 0, 0, "red first");
+ is_color3($row[1], 0, 0, 255, "then blue");
}
{ # general tag tests
#!perl -w
use strict;
-use Test::More tests => 98;
+use Test::More tests => 83;
BEGIN { use_ok(Imager => qw(:all :handy)) }
-require "t/testtools.pl";
init_log("testout/t022double.log", 1);
-use Imager::Test qw(image_bounds_checks);
+use Imager::Test qw(image_bounds_checks test_colorf_gpix test_colorf_glin mask_tests);
use Imager::Color::Float;
test_colorf_gpix($im_rgb, 99, 0, $redf);
test_colorf_gpix($im_rgb, 0, 100, $redf);
test_colorf_gpix($im_rgb, 99, 100, $redf);
-test_colorf_glin($im_rgb, 0, 0, ($redf) x 100);
-test_colorf_glin($im_rgb, 0, 100, ($redf) x 100);
+test_colorf_glin($im_rgb, 0, 0, [ ($redf) x 100 ], 'sanity glin @0');
+test_colorf_glin($im_rgb, 0, 100, [ ($redf) x 100 ], 'sanity glin @100');
Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
test_colorf_glin($im_rgb, 0, 1,
- ($redf) x 20, ($greenf) x 60, ($redf) x 20);
+ [ ($redf) x 20, ($greenf) x 60, ($redf) x 20 ],
+ 'check after write');
# basic OO tests
my $ooimg = Imager->new(xsize=>200, ysize=>201, bits=>'double');
# (It may become useful if the test is moved to ./t subdirectory.)
use lib qw(blib/lib blib/arch);
-BEGIN { require 't/testtools.pl'; }
BEGIN { use_ok('Imager', ':all') }
init_log("testout/t102png.log",1);
use Test::More tests => 132;
use Imager qw(:all);
use Imager::Test qw(is_color3);
-BEGIN { require "t/testtools.pl"; }
+
use Carp 'confess';
$SIG{__DIE__} = sub { confess @_ };
skip("giflib3 doesn't support callbacks", 1) unless $gifver >= 4.0;
++$can_write_callback;
my $good = ext_test(14, <<'ENDOFCODE');
-use Imager;
-require "t/testtools.pl";
-my $timg = test_img();
+use Imager qw(:all);
+use Imager::Test qw(test_image_raw);
+my $timg = test_image_raw();
my @gif_delays = (50) x 5;
my @gif_disposal = (2) x 5;
my @imgs = ($timg) x 5;
#!perl -w
use strict;
-use Test::More tests => 91;
+use Test::More tests => 92;
$|=1;
BEGIN { use_ok(Imager => ':all') }
-require "t/testtools.pl";
use Imager::Test qw(diff_text_with_nul is_color3);
init_log("testout/t35ttfont.log",2);
SKIP:
{
- skip("freetype 1.x unavailable or disabled", 90)
+ skip("freetype 1.x unavailable or disabled", 91)
unless i_has_format("tt");
print "# has tt\n";
# UTF8 encoded \x{2010}
my $dash = pack("C*", 0xE2, 0x80, 0x90);
- diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+ diff_text_with_nul("utf8 dash\\0dash vs dash", "$dash\0$dash", $dash,
font => $font, color => '#FFFFFF', utf8 => 1);
- diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+ diff_text_with_nul("utf8 dash\\0dash vs dash", "$dash\0$dash", $dash,
font => $font, channel => 1, utf8 => 1);
}
+ SKIP:
{ # RT 11972
# when rendering to a transparent image the coverage should be
# expressed in terms of the alpha channel rather than the color
my $font = Imager::Font->new(file=>'fontfiles/ImUgly.ttf', type=>'tt');
+ ok($font, "loaded fontfiles/ImUgly.ttf")
+ or skip("Could not load test font: ".Imager->errstr, 4);
my $im = Imager->new(xsize => 40, ysize => 20, channels => 4);
ok($im->string(string => "AB", size => 20, aa => 1, color => '#F00',
x => 0, y => 15, font => $font),
BEGIN { use_ok(Imager=>':all') }
use Imager::Test qw(is_image is_color4);
-#require "t/testtools.pl";
-
Imager::init('log'=>'testout/t40scale.log');
my $img=Imager->new();
#!perl -w
use strict;
use Test::More tests => 64;
-require "t/testtools.pl";
use Imager;
+use Imager::Test qw(test_image);
#$Imager::DEBUG=1;
# the left of the image, even if left/top are provided, despite the
# sample in the docs
# Let's make sure that things happen as documented
- my $src = test_oo_img();
+ my $src = test_image();
# make sure we get what we want
is($src->getwidth, 150, "src width");
is($src->getheight, 150, "src height");
{ # https://rt.cpan.org/Ticket/Display.html?id=7581
# previously we didn't check that the result had some pixels
# make sure we do
- my $src = test_oo_img();
+ my $src = test_image();
ok(!$src->crop(left=>50, right=>50), "nothing across");
cmp_ok($src->errstr, '=~', qr/resulting image would have no content/,
"and message");
}
{
- my $src = test_oo_img();
+ my $src = test_image();
ok(!$src->crop( top=>1000, bottom=>1500, left=>0, right=>100 ),
"outside of image" );
cmp_ok($src->errstr, '=~', qr/outside of the image/, "and message");
+++ /dev/null
-# this doesn't need a new namespace - I hope
-use strict;
-use Imager qw(:all);
-use vars qw($TESTNUM);
-use Carp 'confess';
-
-$TESTNUM = 1;
-
-sub test_img {
- my $green=i_color_new(0,255,0,255);
- my $blue=i_color_new(0,0,255,255);
- my $red=i_color_new(255,0,0,255);
-
- my $img=Imager::ImgRaw::new(150,150,3);
-
- i_box_filled($img,70,25,130,125,$green);
- i_box_filled($img,20,25,80,125,$blue);
- i_arc($img,75,75,30,0,361,$red);
- i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
-
- $img;
-}
-
-sub test_oo_img {
- my $raw = test_img();
- my $img = Imager->new;
- $img->{IMG} = $raw;
-
- $img;
-}
-
-
-sub _sv_str {
- my ($value) = @_;
-
- if (defined $value) {
- if (!length $value || ($value & ~$value)) {
- $value =~ s/\\/\\\\/g;
- $value =~ s/\r/\\r/g;
- $value =~ s/\n/\\n/g;
- $value =~ s/\t/\\t/g;
- $value =~ s/\"/\\"/g;
- $value =~ s/([^ -\x7E])/"\\x".sprintf("%02x", ord($1))/ge;
-
- return qq!"$value"!;
- }
- else {
- return $value; # a number
- }
- }
- else {
- return "undef";
- }
-}
-
-
-1;
-
-sub test_colorf_gpix {
- my ($im, $x, $y, $expected, $epsilon) = @_;
- my $c = Imager::i_gpixf($im, $x, $y);
- ok($c, "got gpix ($x, $y)");
- unless (ok(colorf_cmp($c, $expected, $epsilon) == 0,
- "got right color ($x, $y)")) {
- print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
- print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
- }
-}
-
-sub test_color_gpix {
- my ($im, $x, $y, $expected) = @_;
- my $c = Imager::i_get_pixel($im, $x, $y);
- ok($c, "got gpix ($x, $y)");
- unless (ok(color_cmp($c, $expected) == 0,
- "got right color ($x, $y)")) {
- print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
- print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
- }
-}
-
-sub test_colorf_glin {
- my ($im, $x, $y, @pels) = @_;
-
- my @got = Imager::i_glinf($im, $x, $x+@pels, $y);
- is(@got, @pels, "check number of pixels ($x, $y)");
- ok(!grep(colorf_cmp($pels[$_], $got[$_], 0.005), 0..$#got),
- "check colors ($x, $y)");
-}
-
-sub colorf_cmp {
- my ($c1, $c2, $epsilon) = @_;
-
- defined $epsilon or $epsilon = 0;
-
- my @s1 = $c1->rgba;
- my @s2 = $c2->rgba;
-
- # print "# (",join(",", @s1[0..2]),") <=> (",join(",", @s2[0..2]),")\n";
- return abs($s1[0]-$s2[0]) >= $epsilon && $s1[0] <=> $s2[0]
- || abs($s1[1]-$s2[1]) >= $epsilon && $s1[1] <=> $s2[1]
- || abs($s1[2]-$s2[2]) >= $epsilon && $s1[2] <=> $s2[2];
-}
-
-sub color_cmp {
- my ($c1, $c2) = @_;
-
- my @s1 = $c1->rgba;
- my @s2 = $c2->rgba;
-
- return $s1[0] <=> $s2[0]
- || $s1[1] <=> $s2[1]
- || $s1[2] <=> $s2[2];
-}
-
-# these test the action of the channel mask on the image supplied
-# which should be an OO image.
-sub mask_tests {
- my ($im, $epsilon) = @_;
-
- defined $epsilon or $epsilon = 0;
-
- # we want to check all four of ppix() and plin(), ppix() and plinf()
- # basic test procedure:
- # first using default/all 1s mask, set to white
- # make sure we got white
- # set mask to skip a channel, set to grey
- # make sure only the right channels set
-
- print "# channel mask tests\n";
- # 8-bit color tests
- my $white = NC(255, 255, 255);
- my $grey = NC(128, 128, 128);
- my $white_grey = NC(128, 255, 128);
-
- print "# with ppix\n";
- ok($im->setmask(mask=>~0), "set to default mask");
- ok($im->setpixel(x=>0, 'y'=>0, color=>$white), "set to white all channels");
- test_color_gpix($im->{IMG}, 0, 0, $white);
- ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
- ok($im->setpixel(x=>0, 'y'=>0, color=>$grey), "set to grey, no channel 2");
- test_color_gpix($im->{IMG}, 0, 0, $white_grey);
-
- print "# with plin\n";
- ok($im->setmask(mask=>~0), "set to default mask");
- ok($im->setscanline(x=>0, 'y'=>1, pixels => [$white]),
- "set to white all channels");
- test_color_gpix($im->{IMG}, 0, 1, $white);
- ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
- ok($im->setscanline(x=>0, 'y'=>1, pixels=>[$grey]),
- "set to grey, no channel 2");
- test_color_gpix($im->{IMG}, 0, 1, $white_grey);
-
- # float color tests
- my $whitef = NCF(1.0, 1.0, 1.0);
- my $greyf = NCF(0.5, 0.5, 0.5);
- my $white_greyf = NCF(0.5, 1.0, 0.5);
-
- print "# with ppixf\n";
- ok($im->setmask(mask=>~0), "set to default mask");
- ok($im->setpixel(x=>0, 'y'=>2, color=>$whitef), "set to white all channels");
- test_colorf_gpix($im->{IMG}, 0, 2, $whitef, $epsilon);
- ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
- ok($im->setpixel(x=>0, 'y'=>2, color=>$greyf), "set to grey, no channel 2");
- test_colorf_gpix($im->{IMG}, 0, 2, $white_greyf, $epsilon);
-
- print "# with plinf\n";
- ok($im->setmask(mask=>~0), "set to default mask");
- ok($im->setscanline(x=>0, 'y'=>3, pixels => [$whitef]),
- "set to white all channels");
- test_colorf_gpix($im->{IMG}, 0, 3, $whitef, $epsilon);
- ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
- ok($im->setscanline(x=>0, 'y'=>3, pixels=>[$greyf]),
- "set to grey, no channel 2");
- test_colorf_gpix($im->{IMG}, 0, 3, $white_greyf, $epsilon);
-
-}
-
projects / imager.git / commitdiff