lib/Imager/Test.pm

   1 package Imager::Test;
   2 use strict;
   3 use Test::Builder;
   4 require Exporter;
   5 use vars qw(@ISA @EXPORT_OK);
   6 @ISA = qw(Exporter);
   7 @EXPORT_OK =
   8   qw(
   9      diff_text_with_nul
  10      test_image_raw
  11      test_image_16
  12      test_image
  13      test_image_double
  14      is_color1
  15      is_color3
  16      is_color4
  17      is_color_close3
  18      is_fcolor4
  19      color_cmp
  20      is_image
  21      is_image_similar
  22      image_bounds_checks
  23      mask_tests
  24      test_colorf_gpix
  25      test_color_gpix
  26      test_colorf_glin);
  27
  28 sub diff_text_with_nul {
  29   my ($desc, $text1, $text2, @params) = @_;
  30
  31   my $builder = Test::Builder->new;
  32
  33   print "# $desc\n";
  34   my $imbase = Imager->new(xsize => 100, ysize => 100);
  35   my $imcopy = Imager->new(xsize => 100, ysize => 100);
  36
  37   $builder->ok($imbase->string(x => 5, 'y' => 50, size => 20,
  38                                string => $text1,
  39                                @params), "$desc - draw text1");
  40   $builder->ok($imcopy->string(x => 5, 'y' => 50, size => 20,
  41                                string => $text2,
  42                                @params), "$desc - draw text2");
  43   $builder->isnt_num(Imager::i_img_diff($imbase->{IMG}, $imcopy->{IMG}), 0,
  44                      "$desc - check result different");
  45 }
  46
  47 sub is_color3($$$$$) {
  48   my ($color, $red, $green, $blue, $comment) = @_;
  49
  50   my $builder = Test::Builder->new;
  51
  52   unless (defined $color) {
  53     $builder->ok(0, $comment);
  54     $builder->diag("color is undef");
  55     return;
  56   }
  57   unless ($color->can('rgba')) {
  58     $builder->ok(0, $comment);
  59     $builder->diag("color is not a color object");
  60     return;
  61   }
  62
  63   my ($cr, $cg, $cb) = $color->rgba;
  64   unless ($builder->ok($cr == $red && $cg == $green && $cb == $blue, $comment)) {
  65     $builder->diag(<<END_DIAG);
  66 Color mismatch:
  67   Red: $red vs $cr
  68 Green: $green vs $cg
  69  Blue: $blue vs $cb
  70 END_DIAG
  71     return;
  72   }
  73
  74   return 1;
  75 }
  76
  77 sub is_color_close3($$$$$$) {
  78   my ($color, $red, $green, $blue, $tolerance, $comment) = @_;
  79
  80   my $builder = Test::Builder->new;
  81
  82   unless (defined $color) {
  83     $builder->ok(0, $comment);
  84     $builder->diag("color is undef");
  85     return;
  86   }
  87   unless ($color->can('rgba')) {
  88     $builder->ok(0, $comment);
  89     $builder->diag("color is not a color object");
  90     return;
  91   }
  92
  93   my ($cr, $cg, $cb) = $color->rgba;
  94   unless ($builder->ok(abs($cr - $red) <= $tolerance
  95                        && abs($cg - $green) <= $tolerance
  96                        && abs($cb - $blue) <= $tolerance, $comment)) {
  97     $builder->diag(<<END_DIAG);
  98 Color out of tolerance ($tolerance):
  99   Red: expected $red vs received $cr
 100 Green: expected $green vs received $cg
 101  Blue: expected $blue vs received $cb
 102 END_DIAG
 103     return;
 104   }
 105
 106   return 1;
 107 }
 108
 109 sub is_color4($$$$$$) {
 110   my ($color, $red, $green, $blue, $alpha, $comment) = @_;
 111
 112   my $builder = Test::Builder->new;
 113
 114   unless (defined $color) {
 115     $builder->ok(0, $comment);
 116     $builder->diag("color is undef");
 117     return;
 118   }
 119   unless ($color->can('rgba')) {
 120     $builder->ok(0, $comment);
 121     $builder->diag("color is not a color object");
 122     return;
 123   }
 124
 125   my ($cr, $cg, $cb, $ca) = $color->rgba;
 126   unless ($builder->ok($cr == $red && $cg == $green && $cb == $blue
 127                        && $ca == $alpha, $comment)) {
 128     $builder->diag(<<END_DIAG);
 129 Color mismatch:
 130   Red: $red vs $cr
 131 Green: $green vs $cg
 132  Blue: $blue vs $cb
 133 Alpha: $alpha vs $ca
 134 END_DIAG
 135     return;
 136   }
 137
 138   return 1;
 139 }
 140
 141 sub is_fcolor4($$$$$$;$) {
 142   my ($color, $red, $green, $blue, $alpha, $comment_or_diff, $comment_or_undef) = @_;
 143   my ($comment, $mindiff);
 144   if (defined $comment_or_undef) {
 145     ( $mindiff, $comment ) = ( $comment_or_diff, $comment_or_undef )
 146   }
 147   else {
 148     ( $mindiff, $comment ) = ( 0.001, $comment_or_diff )
 149   }
 150
 151   my $builder = Test::Builder->new;
 152
 153   unless (defined $color) {
 154     $builder->ok(0, $comment);
 155     $builder->diag("color is undef");
 156     return;
 157   }
 158   unless ($color->can('rgba')) {
 159     $builder->ok(0, $comment);
 160     $builder->diag("color is not a color object");
 161     return;
 162   }
 163
 164   my ($cr, $cg, $cb, $ca) = $color->rgba;
 165   unless ($builder->ok(abs($cr - $red) <= $mindiff
 166                        && abs($cg - $green) <= $mindiff
 167                        && abs($cb - $blue) <= $mindiff
 168                        && abs($ca - $alpha) <= $mindiff, $comment)) {
 169     $builder->diag(<<END_DIAG);
 170 Color mismatch:
 171   Red: $red vs $cr
 172 Green: $green vs $cg
 173  Blue: $blue vs $cb
 174 Alpha: $alpha vs $ca
 175 END_DIAG
 176     return;
 177   }
 178
 179   return 1;
 180 }
 181
 182 sub is_color1($$$) {
 183   my ($color, $grey, $comment) = @_;
 184
 185   my $builder = Test::Builder->new;
 186
 187   unless (defined $color) {
 188     $builder->ok(0, $comment);
 189     $builder->diag("color is undef");
 190     return;
 191   }
 192   unless ($color->can('rgba')) {
 193     $builder->ok(0, $comment);
 194     $builder->diag("color is not a color object");
 195     return;
 196   }
 197
 198   my ($cgrey) = $color->rgba;
 199   unless ($builder->ok($cgrey == $grey, $comment)) {
 200     $builder->diag(<<END_DIAG);
 201 Color mismatch:
 202   Grey: $grey vs $cgrey
 203 END_DIAG
 204     return;
 205   }
 206
 207   return 1;
 208 }
 209
 210 sub test_image_raw {
 211   my $green=Imager::i_color_new(0,255,0,255);
 212   my $blue=Imager::i_color_new(0,0,255,255);
 213   my $red=Imager::i_color_new(255,0,0,255);
 214
 215   my $img=Imager::ImgRaw::new(150,150,3);
 216
 217   Imager::i_box_filled($img,70,25,130,125,$green);
 218   Imager::i_box_filled($img,20,25,80,125,$blue);
 219   Imager::i_arc($img,75,75,30,0,361,$red);
 220   Imager::i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
 221
 222   $img;
 223 }
 224
 225 sub test_image {
 226   my $green = Imager::Color->new(0, 255, 0, 255);
 227   my $blue  = Imager::Color->new(0, 0, 255, 255);
 228   my $red   = Imager::Color->new(255, 0, 0, 255);
 229   my $img = Imager->new(xsize => 150, ysize => 150);
 230   $img->box(filled => 1, color => $green, box => [ 70, 24, 130, 124 ]);
 231   $img->box(filled => 1, color => $blue,  box => [ 20, 26, 80, 126 ]);
 232   $img->arc(x => 75, y => 75, r => 30, color => $red);
 233   $img->filter(type => 'conv', coef => [ 0.1, 0.2, 0.4, 0.2, 0.1 ]);
 234
 235   $img;
 236 }
 237
 238 sub test_image_16 {
 239   my $green = Imager::Color->new(0, 255, 0, 255);
 240   my $blue  = Imager::Color->new(0, 0, 255, 255);
 241   my $red   = Imager::Color->new(255, 0, 0, 255);
 242   my $img = Imager->new(xsize => 150, ysize => 150, bits => 16);
 243   $img->box(filled => 1, color => $green, box => [ 70, 25, 130, 125 ]);
 244   $img->box(filled => 1, color => $blue,  box => [ 20, 25, 80, 125 ]);
 245   $img->arc(x => 75, y => 75, r => 30, color => $red);
 246   $img->filter(type => 'conv', coef => [ 0.1, 0.2, 0.4, 0.2, 0.1 ]);
 247
 248   $img;
 249 }
 250
 251 sub test_image_double {
 252   my $green = Imager::Color->new(0, 255, 0, 255);
 253   my $blue  = Imager::Color->new(0, 0, 255, 255);
 254   my $red   = Imager::Color->new(255, 0, 0, 255);
 255   my $img = Imager->new(xsize => 150, ysize => 150, bits => 'double');
 256   $img->box(filled => 1, color => $green, box => [ 70, 25, 130, 125 ]);
 257   $img->box(filled => 1, color => $blue,  box => [ 20, 25, 80, 125 ]);
 258   $img->arc(x => 75, y => 75, r => 30, color => $red);
 259   $img->filter(type => 'conv', coef => [ 0.1, 0.2, 0.4, 0.2, 0.1 ]);
 260
 261   $img;
 262 }
 263
 264 sub is_image_similar($$$$) {
 265   my ($left, $right, $limit, $comment) = @_;
 266
 267   my $builder = Test::Builder->new;
 268
 269   unless (defined $left) {
 270     $builder->ok(0, $comment);
 271     $builder->diag("left is undef");
 272     return;
 273   }
 274   unless (defined $right) {
 275     $builder->ok(0, $comment);
 276     $builder->diag("right is undef");
 277     return;
 278   }
 279   unless ($left->{IMG}) {
 280     $builder->ok(0, $comment);
 281     $builder->diag("left image has no low level object");
 282     return;
 283   }
 284   unless ($right->{IMG}) {
 285     $builder->ok(0, $comment);
 286     $builder->diag("right image has no low level object");
 287     return;
 288   }
 289   unless ($left->getwidth == $right->getwidth) {
 290     $builder->ok(0, $comment);
 291     $builder->diag("left width " . $left->getwidth . " vs right width "
 292                    . $right->getwidth);
 293     return;
 294   }
 295   unless ($left->getheight == $right->getheight) {
 296     $builder->ok(0, $comment);
 297     $builder->diag("left height " . $left->getheight . " vs right height "
 298                    . $right->getheight);
 299     return;
 300   }
 301   unless ($left->getchannels == $right->getchannels) {
 302     $builder->ok(0, $comment);
 303     $builder->diag("left channels " . $left->getchannels . " vs right channels "
 304                    . $right->getchannels);
 305     return;
 306   }
 307   my $diff = Imager::i_img_diff($left->{IMG}, $right->{IMG});
 308   if ($diff > $limit) {
 309     $builder->ok(0, $comment);
 310     $builder->diag("image data difference > $limit - $diff");
 311
 312     if ($limit == 0) {
 313       # find the first mismatch
 314       PIXELS:
 315       for my $y (0 .. $left->getheight()-1) {
 316         for my $x (0.. $left->getwidth()-1) {
 317           my @lsamples = $left->getsamples(x => $x, y => $y, width => 1);
 318           my @rsamples = $right->getsamples(x => $x, y => $y, width => 1);
 319           if ("@lsamples" ne "@rsamples") {
 320             $builder->diag("first mismatch at ($x, $y) - @lsamples vs @rsamples");
 321             last PIXELS;
 322           }
 323         }
 324       }
 325     }
 326
 327     return;
 328   }
 329
 330   return $builder->ok(1, $comment);
 331 }
 332
 333 sub is_image($$$) {
 334   my ($left, $right, $comment) = @_;
 335
 336   local $Test::Builder::Level = $Test::Builder::Level + 1;
 337
 338   return is_image_similar($left, $right, 0, $comment);
 339 }
 340
 341 sub image_bounds_checks {
 342   my $im = shift;
 343
 344   my $builder = Test::Builder->new;
 345
 346   $builder->ok(!$im->getpixel(x => -1, y => 0), 'bounds check get (-1, 0)');
 347   $builder->ok(!$im->getpixel(x => 10, y => 0), 'bounds check get (10, 0)');
 348   $builder->ok(!$im->getpixel(x => 0, y => -1), 'bounds check get (0, -1)');
 349   $builder->ok(!$im->getpixel(x => 0, y => 10), 'bounds check get (0, 10)');
 350   $builder->ok(!$im->getpixel(x => -1, y => 0), 'bounds check get (-1, 0) float');
 351   $builder->ok(!$im->getpixel(x => 10, y => 0), 'bounds check get (10, 0) float');
 352   $builder->ok(!$im->getpixel(x => 0, y => -1), 'bounds check get (0, -1) float');
 353   $builder->ok(!$im->getpixel(x => 0, y => 10), 'bounds check get (0, 10) float');
 354   my $black = Imager::Color->new(0, 0, 0);
 355   require Imager::Color::Float;
 356   my $blackf = Imager::Color::Float->new(0, 0, 0);
 357   $builder->ok(!$im->setpixel(x => -1, y => 0, color => $black), 'bounds check set (-1, 0)');
 358   $builder->ok(!$im->setpixel(x => 10, y => 0, color => $black), 'bounds check set (10, 0)');
 359   $builder->ok(!$im->setpixel(x => 0, y => -1, color => $black), 'bounds check set (0, -1)');
 360   $builder->ok(!$im->setpixel(x => 0, y => 10, color => $black), 'bounds check set (0, 10)');
 361   $builder->ok(!$im->setpixel(x => -1, y => 0, color => $blackf), 'bounds check set (-1, 0) float');
 362   $builder->ok(!$im->setpixel(x => 10, y => 0, color => $blackf), 'bounds check set (10, 0) float');
 363   $builder->ok(!$im->setpixel(x => 0, y => -1, color => $blackf), 'bounds check set (0, -1) float');
 364   $builder->ok(!$im->setpixel(x => 0, y => 10, color => $blackf), 'bounds check set (0, 10) float');
 365 }
 366
 367 sub test_colorf_gpix {
 368   my ($im, $x, $y, $expected, $epsilon, $comment) = @_;
 369
 370   my $builder = Test::Builder->new;
 371
 372   defined $comment or $comment = '';
 373
 374   my $c = Imager::i_gpixf($im, $x, $y);
 375   unless ($c) {
 376     $builder->ok(0, "$comment - retrieve color at ($x,$y)");
 377     return;
 378   }
 379   unless ($builder->ok(colorf_cmp($c, $expected, $epsilon) == 0,
 380              "$comment - got right color ($x, $y)")) {
 381     my @c = $c->rgba;
 382     my @exp = $expected->rgba;
 383     $builder->diag(<<EOS);
 384 # got: ($c[0], $c[1], $c[2])
 385 # expected: ($exp[0], $exp[1], $exp[2])
 386 EOS
 387   }
 388   1;
 389 }
 390
 391 sub test_color_gpix {
 392   my ($im, $x, $y, $expected, $comment) = @_;
 393
 394   my $builder = Test::Builder->new;
 395
 396   defined $comment or $comment = '';
 397   my $c = Imager::i_get_pixel($im, $x, $y);
 398   unless ($c) {
 399     $builder->ok(0, "$comment - retrieve color at ($x,$y)");
 400     return;
 401   }
 402   unless ($builder->ok(color_cmp($c, $expected) == 0,
 403      "got right color ($x, $y)")) {
 404     my @c = $c->rgba;
 405     my @exp = $expected->rgba;
 406     $builder->diag(<<EOS);
 407 # got: ($c[0], $c[1], $c[2])
 408 # expected: ($exp[0], $exp[1], $exp[2])
 409 EOS
 410     return;
 411   }
 412
 413   return 1;
 414 }
 415
 416 sub test_colorf_glin {
 417   my ($im, $x, $y, $pels, $comment) = @_;
 418
 419   my $builder = Test::Builder->new;
 420
 421   my @got = Imager::i_glinf($im, $x, $x+@$pels, $y);
 422   @got == @$pels
 423     or return $builder->is_num(scalar(@got), scalar(@$pels), "$comment - pixels retrieved");
 424
 425   return $builder->ok(!grep(colorf_cmp($pels->[$_], $got[$_], 0.005), 0..$#got),
 426      "$comment - check colors ($x, $y)");
 427 }
 428
 429 sub colorf_cmp {
 430   my ($c1, $c2, $epsilon) = @_;
 431
 432   defined $epsilon or $epsilon = 0;
 433
 434   my @s1 = $c1->rgba;
 435   my @s2 = $c2->rgba;
 436
 437   # print "# (",join(",", @s1[0..2]),") <=> (",join(",", @s2[0..2]),")\n";
 438   return abs($s1[0]-$s2[0]) >= $epsilon && $s1[0] <=> $s2[0]
 439     || abs($s1[1]-$s2[1]) >= $epsilon && $s1[1] <=> $s2[1]
 440       || abs($s1[2]-$s2[2]) >= $epsilon && $s1[2] <=> $s2[2];
 441 }
 442
 443 sub color_cmp {
 444   my ($c1, $c2) = @_;
 445
 446   my @s1 = $c1->rgba;
 447   my @s2 = $c2->rgba;
 448
 449   return $s1[0] <=> $s2[0]
 450     || $s1[1] <=> $s2[1]
 451       || $s1[2] <=> $s2[2];
 452 }
 453
 454 # these test the action of the channel mask on the image supplied
 455 # which should be an OO image.
 456 sub mask_tests {
 457   my ($im, $epsilon) = @_;
 458
 459   my $builder = Test::Builder->new;
 460
 461   defined $epsilon or $epsilon = 0;
 462
 463   # we want to check all four of ppix() and plin(), ppix() and plinf()
 464   # basic test procedure:
 465   #   first using default/all 1s mask, set to white
 466   #   make sure we got white
 467   #   set mask to skip a channel, set to grey
 468   #   make sure only the right channels set
 469
 470   print "# channel mask tests\n";
 471   # 8-bit color tests
 472   my $white = Imager::NC(255, 255, 255);
 473   my $grey = Imager::NC(128, 128, 128);
 474   my $white_grey = Imager::NC(128, 255, 128);
 475
 476   print "# with ppix\n";
 477   $builder->ok($im->setmask(mask=>~0), "set to default mask");
 478   $builder->ok($im->setpixel(x=>0, 'y'=>0, color=>$white), "set to white all channels");
 479   test_color_gpix($im->{IMG}, 0, 0, $white, "ppix");
 480   $builder->ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
 481   $builder->ok($im->setpixel(x=>0, 'y'=>0, color=>$grey), "set to grey, no channel 2");
 482   test_color_gpix($im->{IMG}, 0, 0, $white_grey, "ppix masked");
 483
 484   print "# with plin\n";
 485   $builder->ok($im->setmask(mask=>~0), "set to default mask");
 486   $builder->ok($im->setscanline(x=>0, 'y'=>1, pixels => [$white]),
 487      "set to white all channels");
 488   test_color_gpix($im->{IMG}, 0, 1, $white, "plin");
 489   $builder->ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
 490   $builder->ok($im->setscanline(x=>0, 'y'=>1, pixels=>[$grey]),
 491      "set to grey, no channel 2");
 492   test_color_gpix($im->{IMG}, 0, 1, $white_grey, "plin masked");
 493
 494   # float color tests
 495   my $whitef = Imager::NCF(1.0, 1.0, 1.0);
 496   my $greyf = Imager::NCF(0.5, 0.5, 0.5);
 497   my $white_greyf = Imager::NCF(0.5, 1.0, 0.5);
 498
 499   print "# with ppixf\n";
 500   $builder->ok($im->setmask(mask=>~0), "set to default mask");
 501   $builder->ok($im->setpixel(x=>0, 'y'=>2, color=>$whitef), "set to white all channels");
 502   test_colorf_gpix($im->{IMG}, 0, 2, $whitef, $epsilon, "ppixf");
 503   $builder->ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
 504   $builder->ok($im->setpixel(x=>0, 'y'=>2, color=>$greyf), "set to grey, no channel 2");
 505   test_colorf_gpix($im->{IMG}, 0, 2, $white_greyf, $epsilon, "ppixf masked");
 506
 507   print "# with plinf\n";
 508   $builder->ok($im->setmask(mask=>~0), "set to default mask");
 509   $builder->ok($im->setscanline(x=>0, 'y'=>3, pixels => [$whitef]),
 510      "set to white all channels");
 511   test_colorf_gpix($im->{IMG}, 0, 3, $whitef, $epsilon, "plinf");
 512   $builder->ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
 513   $builder->ok($im->setscanline(x=>0, 'y'=>3, pixels=>[$greyf]),
 514      "set to grey, no channel 2");
 515   test_colorf_gpix($im->{IMG}, 0, 3, $white_greyf, $epsilon, "plinf masked");
 516
 517 }
 518
 519 1;
 520
 521 __END__
 522
 523 =head1 NAME
 524
 525 Imager::Test - common functions used in testing Imager
 526
 527 =head1 SYNOPSIS
 528
 529   use Imager::Test 'diff_text_with_nul';
 530   diff_text_with_nul($test_name, $text1, $text2, @string_options);
 531
 532 =head1 DESCRIPTION
 533
 534 This is a repository of functions used in testing Imager.
 535
 536 Some functions will only be useful in testing Imager itself, while
 537 others should be useful in testing modules that use Imager.
 538
 539 No functions are exported by default.
 540
 541 =head1 FUNCTIONS
 542
 543 =over
 544
 545 =item is_color3($color, $red, $blue, $green, $comment)
 546
 547 Tests is $color matches the given ($red, $blue, $green)
 548
 549 =item is_image($im1, $im2, $comment)
 550
 551 Tests if the 2 images have the same content.  Both images must be
 552 defined, have the same width, height, channels and the same color in
 553 each pixel.  The color comparison is done at 8-bits per pixel.  The
 554 color representation such as direct vs paletted, bits per sample are
 555 not checked.  Equivalent to is_image_similar($im1, $im2, 0, $comment).
 556
 557 =item is_image_similar($im1, $im2, $maxdiff, $comment)
 558
 559 Tests if the 2 images have similar content.  Both images must be
 560 defined, have the same width, height and channels.  The cum of the
 561 squares of the differences of each sample are calculated and must be
 562 less than or equal to I<$maxdiff> for the test to pass.  The color
 563 comparison is done at 8-bits per pixel.  The color representation such
 564 as direct vs paletted, bits per sample are not checked.
 565
 566 =item test_image_raw()
 567
 568 Returns a 150x150x3 Imager::ImgRaw test image.
 569
 570 =item test_image()
 571
 572 Returns a 150x150x3 8-bit/sample OO test image.
 573
 574 =item test_image_16()
 575
 576 Returns a 150x150x3 16-bit/sample OO test image.
 577
 578 =item test_image_double()
 579
 580 Returns a 150x150x3 double/sample OO test image.
 581
 582 =item diff_text_with_nul($test_name, $text1, $text2, @options)
 583
 584 Creates 2 test images and writes $text1 to the first image and $text2
 585 to the second image with the string() method.  Each call adds 3 ok/not
 586 ok to the output of the test script.
 587
 588 Extra options that should be supplied include the font and either a
 589 color or channel parameter.
 590
 591 This was explicitly created for regression tests on #21770.
 592
 593 =item image_bounds_checks($im)
 594
 595 Attempts to write to various pixel positions outside the edge of the
 596 image to ensure that it fails in those locations.
 597
 598 Any new image type should pass these tests.  Does 16 separate tests.
 599
 600 =item test_colorf_gpix($im, $x, $y, $expected, $epsilon, $comment)
 601
 602 Retrieves the pixel ($x,$y) from the low-level image $im and compares
 603 it to the floating point color $expected, with a tolerance of epsilon.
 604
 605 =item test_color_gpix($im, $x, $y, $expected, $comment)
 606
 607 Retrieves the pixel ($x,$y) from the low-level image $im and compares
 608 it to the floating point color $expected.
 609
 610 =item test_colorf_glin($im, $x, $y, $pels, $comment)
 611
 612 Retrieves the floating point pixels ($x, $y)-[$x+@$pels, $y] from the
 613 low level image $im and compares them against @$pels.
 614
 615 =item mask_tests($im, $epsilon)
 616
 617 Perform a standard set of mask tests on the OO image $im.
 618
 619 =back
 620
 621 =head1 AUTHOR
 622
 623 Tony Cook <tony@develop-help.com>
 624
 625 =cut