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