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