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