- use scanline oriented operations to flip images instead of pixel
[imager.git] / lib / Imager / Test.pm
CommitLineData
9a6ab99c
TC
1package Imager::Test;
2use strict;
3use Test::Builder;
4require Exporter;
5use vars qw(@ISA @EXPORT_OK);
6@ISA = qw(Exporter);
8927ff88
TC
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
e41cfe8f 21 is_imaged
8927ff88
TC
22 is_image_similar
23 image_bounds_checks
24 mask_tests
25 test_colorf_gpix
26 test_color_gpix
27 test_colorf_glin);
9a6ab99c
TC
28
29sub 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
9c106321
TC
48sub 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);
67Color mismatch:
68 Red: $red vs $cr
69Green: $green vs $cg
70 Blue: $blue vs $cb
71END_DIAG
72 return;
73 }
74
75 return 1;
76}
77
6e4af7d4
TC
78sub 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);
99Color out of tolerance ($tolerance):
100 Red: expected $red vs received $cr
101Green: expected $green vs received $cg
102 Blue: expected $blue vs received $cb
103END_DIAG
104 return;
105 }
106
107 return 1;
108}
109
b3aa972f
TC
110sub 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);
130Color mismatch:
52f2b10a
TC
131 Red: $cr vs $red
132Green: $cg vs $green
133 Blue: $cb vs $blue
134Alpha: $ca vs $alpha
b3aa972f
TC
135END_DIAG
136 return;
137 }
138
139 return 1;
140}
141
142sub 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);
171Color mismatch:
52f2b10a
TC
172 Red: $cr vs $red
173Green: $cg vs $green
174 Blue: $cb vs $blue
175Alpha: $ca vs $alpha
b3aa972f
TC
176END_DIAG
177 return;
178 }
179
180 return 1;
181}
182
9c106321
TC
183sub 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);
202Color mismatch:
203 Grey: $grey vs $cgrey
204END_DIAG
205 return;
206 }
207
208 return 1;
209}
210
211sub 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
167660cd
TC
226sub 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);
d5477d3d
TC
231 $img->box(filled => 1, color => $green, box => [ 70, 24, 130, 124 ]);
232 $img->box(filled => 1, color => $blue, box => [ 20, 26, 80, 126 ]);
167660cd
TC
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
9c106321
TC
239sub 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
bd8052a6
TC
252sub 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
e41cfe8f
TC
265sub _low_image_diff_check {
266 my ($left, $right, $comment) = @_;
9c106321
TC
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 }
e41cfe8f
TC
308
309 return 1;
310}
311
312sub 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
9c106321 324 my $diff = Imager::i_img_diff($left->{IMG}, $right->{IMG});
167660cd 325 if ($diff > $limit) {
9c106321 326 $builder->ok(0, $comment);
167660cd 327 $builder->diag("image data difference > $limit - $diff");
bd8052a6
TC
328
329 if ($limit == 0) {
330 # find the first mismatch
c5f447ac 331 PIXELS:
bd8052a6
TC
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");
c5f447ac 338 last PIXELS;
bd8052a6
TC
339 }
340 }
341 }
342 }
343
9c106321
TC
344 return;
345 }
346
347 return $builder->ok(1, $comment);
348}
349
167660cd
TC
350sub 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
e41cfe8f
TC
358sub 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
837a4b43
TC
394sub 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}
167660cd 419
bd8052a6
TC
420sub 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 }
8927ff88 432 unless ($builder->ok(colorf_cmp($c, $expected, $epsilon) == 0,
bd8052a6 433 "$comment - got right color ($x, $y)")) {
8927ff88
TC
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])
439EOS
bd8052a6
TC
440 }
441 1;
442}
443
444sub 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 }
8927ff88 455 unless ($builder->ok(color_cmp($c, $expected) == 0,
bd8052a6 456 "got right color ($x, $y)")) {
8927ff88
TC
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])
462EOS
bd8052a6
TC
463 return;
464 }
465
466 return 1;
467}
468
469sub 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
8927ff88 478 return $builder->ok(!grep(colorf_cmp($pels->[$_], $got[$_], 0.005), 0..$#got),
bd8052a6
TC
479 "$comment - check colors ($x, $y)");
480}
481
8927ff88 482sub colorf_cmp {
bd8052a6
TC
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
8927ff88 496sub color_cmp {
bd8052a6
TC
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.
509sub 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
9a6ab99c
TC
5721;
573
574__END__
575
576=head1 NAME
577
578Imager::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
587This is a repository of functions used in testing Imager.
588
589Some functions will only be useful in testing Imager itself, while
590others should be useful in testing modules that use Imager.
591
592No functions are exported by default.
593
594=head1 FUNCTIONS
595
596=over
597
9c106321
TC
598=item is_color3($color, $red, $blue, $green, $comment)
599
600Tests is $color matches the given ($red, $blue, $green)
601
ae12796a
TC
602=item is_image($im1, $im2, $comment)
603
604Tests if the 2 images have the same content. Both images must be
605defined, have the same width, height, channels and the same color in
606each pixel. The color comparison is done at 8-bits per pixel. The
607color representation such as direct vs paletted, bits per sample are
2fac3132
TC
608not checked. Equivalent to is_image_similar($im1, $im2, 0, $comment).
609
e41cfe8f
TC
610=item is_imaged($im, $im2, $comment)
611
612Tests if the two images have the same content at the double/sample
613level.
614
2fac3132
TC
615=item is_image_similar($im1, $im2, $maxdiff, $comment)
616
617Tests if the 2 images have similar content. Both images must be
618defined, have the same width, height and channels. The cum of the
619squares of the differences of each sample are calculated and must be
620less than or equal to I<$maxdiff> for the test to pass. The color
621comparison is done at 8-bits per pixel. The color representation such
622as direct vs paletted, bits per sample are not checked.
ae12796a 623
9c106321
TC
624=item test_image_raw()
625
626Returns a 150x150x3 Imager::ImgRaw test image.
627
d5477d3d
TC
628=item test_image()
629
630Returns a 150x150x3 8-bit/sample OO test image.
631
9c106321
TC
632=item test_image_16()
633
634Returns a 150x150x3 16-bit/sample OO test image.
635
bd8052a6
TC
636=item test_image_double()
637
638Returns a 150x150x3 double/sample OO test image.
639
9c106321 640=item diff_text_with_nul($test_name, $text1, $text2, @options)
9a6ab99c
TC
641
642Creates 2 test images and writes $text1 to the first image and $text2
643to the second image with the string() method. Each call adds 3 ok/not
644ok to the output of the test script.
645
646Extra options that should be supplied include the font and either a
647color or channel parameter.
648
649This was explicitly created for regression tests on #21770.
650
2fac3132
TC
651=item image_bounds_checks($im)
652
653Attempts to write to various pixel positions outside the edge of the
654image to ensure that it fails in those locations.
655
656Any new image type should pass these tests. Does 16 separate tests.
657
bd8052a6
TC
658=item test_colorf_gpix($im, $x, $y, $expected, $epsilon, $comment)
659
660Retrieves the pixel ($x,$y) from the low-level image $im and compares
661it to the floating point color $expected, with a tolerance of epsilon.
662
663=item test_color_gpix($im, $x, $y, $expected, $comment)
664
665Retrieves the pixel ($x,$y) from the low-level image $im and compares
666it to the floating point color $expected.
667
668=item test_colorf_glin($im, $x, $y, $pels, $comment)
669
670Retrieves the floating point pixels ($x, $y)-[$x+@$pels, $y] from the
671low level image $im and compares them against @$pels.
672
673=item mask_tests($im, $epsilon)
674
675Perform a standard set of mask tests on the OO image $im.
676
9a6ab99c
TC
677=back
678
679=head1 AUTHOR
680
681Tony Cook <tony@develop-help.com>
682
683=cut