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