1#  Copyright 1999-2021 ImageMagick Studio LLC, a non-profit organization
2#  dedicated to making software imaging solutions freely available.
3#
4#  You may not use this file except in compliance with the License.  You may
5#  obtain a copy of the License at
6#
7#    https://imagemagick.org/script/license.php
8#
9#  Unless required by applicable law or agreed to in writing, software
10#  distributed under the License is distributed on an "AS IS" BASIS,
11#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12#  See the License for the specific language governing permissions and
13#  limitations under the License.
14#
15#
16# Common subroutines to support tests
17#
18# Contributed by Bob Friesenhahn <bfriesen@simple.dallas.tx.us>
19#
20
21#
22# Test composite method using comparison with a reference image
23#
24# Usage: testFilterCompare( background image name, background read options,
25#                           composite image name, composite read options,
26#                           composite options,reference image
27#                           normalized_mean_error,
28#                           normalized_maximum_error );
29sub testCompositeCompare {
30  my ($background_name,
31      $background_read_options,
32      $composite_name,
33      $composite_read_options,
34      $composite_options,
35      $refimage_name,
36      $normalized_mean_error_max,
37      $normalized_maximum_error_max) = @_;
38  my ($background,
39      $composite,
40      $errorinfo,
41      $normalized_maximum_error,
42      $normalized_mean_error,
43      $refimage,
44      $status);
45
46  $errorinfo='';
47  $status='';
48  $normalized_mean_error_max+=1.0e-12;
49  $normalized_maximum_error_max+=1.0e-12;
50
51  #print( $filter, " ...\n" );
52
53  # Create images
54  $background=Image::Magick->new;
55  $composite=Image::Magick->new;
56  $refimage=Image::Magick->new;
57
58  # Read background image
59  if ( "$background_read_options" ne "" ) {
60    print("Set($background_read_options) ...\n");
61    eval "\$status=\$background->Set($background_read_options);";
62    if ("$status")
63      {
64        $errorinfo = "Set($background_read_options): $status";
65        goto COMPARE_RUNTIME_ERROR;
66      }
67  }
68  $status=$background->ReadImage($background_name);
69  if ("$status")
70    {
71      $errorinfo = "Readimage ($background_name): $status";
72      goto COMPARE_RUNTIME_ERROR;
73    }
74
75  # Read composite image
76  if ( "$composite_read_options" ne "" ) {
77    print("Set($composite_read_options) ...\n");
78    eval "\$status=\$composite->Set($composite_read_options);";
79    if ("$status")
80      {
81        $errorinfo = "Set($composite_read_options): $status";
82        goto COMPARE_RUNTIME_ERROR;
83      }
84  }
85  $status=$composite->ReadImage($composite_name);
86  if ("$status")
87    {
88      $errorinfo = "Readimage ($composite_name): $status";
89      goto COMPARE_RUNTIME_ERROR;
90    }
91
92  # Do composition
93  print("Composite\($composite_options\) ...\n");
94  eval "\$status=\$background->Composite(image=>\$composite, $composite_options);";
95  if ("$status")
96    {
97      $errorinfo = "Composite ($composite_options): $status";
98      goto COMPARE_RUNTIME_ERROR;
99    }
100
101  $background->Clamp();
102  $background->set(depth=>8);
103#  if ("$filter" eq "Atop") {
104#    $background->write(filename=>"$refimage_name", compression=>'None');
105#  $background->Display();
106#  }
107
108  $status=$refimage->ReadImage("$refimage_name");
109  if ("$status")
110    {
111      $errorinfo = "Readimage ($refimage_name): $status";
112      goto COMPARE_RUNTIME_ERROR;
113    }
114
115  $status=$background->Difference($refimage);
116  if ("$status")
117    {
118      $errorinfo = "Difference($refimage_name): $status";
119      print("  Reference: ", $refimage->Get('columns'), "x", $refimage->Get('rows'), "\n");
120      print("  Computed:  ", $background->Get('columns'), "x", $background->Get('rows'), "\n");
121      goto COMPARE_RUNTIME_ERROR;
122    }
123
124  $normalized_mean_error=0;
125  $normalized_mean_error=$background->GetAttribute('mean-error');
126  if ( !defined($normalized_mean_error) )
127    {
128      $errorinfo = "GetAttribute('mean-error') returned undefined value!";
129      goto COMPARE_RUNTIME_ERROR;
130    }
131  $normalized_maximum_error=0;
132  $normalized_maximum_error=$background->GetAttribute('maximum-error');
133  if ( ! defined($normalized_maximum_error) )
134    {
135      $errorinfo = "GetAttribute('maximum-error') returned undefined value!";
136      goto COMPARE_RUNTIME_ERROR;
137    }
138  if ( ($normalized_mean_error > $normalized_mean_error_max) ||
139       ($normalized_maximum_error > $normalized_maximum_error_max) )
140    {
141      print("  mean-error=$normalized_mean_error, maximum-error=$normalized_maximum_error\n");
142      print "not ok $test\n";
143      $background->Display();
144      undef $background;
145      undef $composite;
146      undef $refimage;
147      return 1
148    }
149
150  undef $background;
151  undef $composite;
152  undef $refimage;
153  print "ok $test\n";
154  return 0;
155
156 COMPARE_RUNTIME_ERROR:
157  undef $background;
158  undef $composite;
159  undef $refimage;
160  print("  $errorinfo\n");
161  print "not ok $test\n";
162  return 1
163}
164
165#
166# Test reading a 16-bit file in which two signatures are possible,
167# depending on whether 16-bit pixels data has been enabled
168#
169# Usage: testRead( read filename, expected ref_8 [, expected ref_16] [, expected ref_32] );
170#
171sub testRead {
172  my( $infile, $ref_8, $ref_16, $ref_32 ) =  @_;
173
174  my($image,$magick,$success,$ref_signature);
175
176  $failure=0;
177
178  if ( !defined( $ref_16 ) )
179    {
180      $ref_16 = $ref_8;
181    }
182  if ( !defined( $ref_32 ) )
183    {
184      $ref_32 = $ref_16;
185    }
186
187  if (Image::Magick->new()->QuantumDepth == 32)
188    {
189      $ref_signature=$ref_32;
190    }
191  elsif (Image::Magick->new()->QuantumDepth == 16)
192    {
193      $ref_signature=$ref_16;
194    }
195  else
196    {
197      $ref_signature=$ref_8;
198    }
199
200  $magick='';
201
202  #
203  # Test reading from file
204  #
205  {
206    my($image, $signature, $status);
207
208    print( "  testing reading from file \"", $infile, "\" ...\n");
209    $image=Image::Magick->new;
210    $image->Set(size=>'512x512');
211    $status=$image->ReadImage("$infile");
212    if( "$status" && !($status =~ /Exception ((315)|(350))/)) {
213      print "ReadImage $infile: $status\n";
214      ++$failure;
215    } else {
216      if( "$status" ) {
217        print "ReadImage $infile: $status\n";
218      }
219      undef $status;
220      $magick=$image->Get('magick');
221      $signature=$image->Get('signature');
222
223      if ( $signature ne $ref_signature ) {
224        print "ReadImage()\n";
225       	print "Image: $infile, signatures do not match.\n";
226      	print "     Expected: $ref_signature\n";
227      	print "     Computed: $signature\n";
228        print "     Depth:    ", Image::Magick->new()->QuantumDepth, "\n";
229        ++$failure;
230        $image->Display();
231      }
232    }
233    undef $image;
234  }
235
236  #
237  # Test reading from blob
238  #
239  if (!($infile =~ /\.bz2$/) && !($infile =~ /\.gz$/) && !($infile =~ /\.Z$/))
240  {
241    my(@blob, $blob_length, $image, $signature, $status);
242
243    if( open( FILE, "< $infile"))
244      {
245        print( "  testing reading from BLOB with magick \"", $magick, "\"...\n");
246        binmode( FILE );
247        $blob_length = read( FILE, $blob, 10000000 );
248        close( FILE );
249        if( defined( $blob ) ) {
250          $image=Image::Magick->new(magick=>$magick);
251          $status=$image->BlobToImage( $blob );
252          undef $blob;
253          if( "$status" && !($status =~ /Exception ((315)|(350))/)) {
254            print "BlobToImage $infile: $status\n";
255            ++$failure;
256          } else {
257            if( "$status" ) {
258              print "ReadImage $infile: $status\n";
259            }
260            $signature=$image->Get('signature');
261            if ( $signature ne $ref_signature ) {
262              print "BlobToImage()\n";
263              print "Image: $infile, signatures do not match.\n";
264              print "     Expected: $ref_signature\n";
265              print "     Computed: $signature\n";
266              print "     Depth:    ", Image::Magick->new()->QuantumDepth, "\n";
267              #$image->Display();
268              ++$failure;
269            }
270          }
271        }
272      }
273    undef $image;
274  }
275
276  #
277  # Display test status
278  #
279  if ( $failure != 0 ) {
280    print "not ok $test\n";
281  } else {
282    print "ok $test\n";
283  }
284}
285
286
287#
288# Test reading a file, and compare with a reference file
289#
290sub testReadCompare {
291  my( $srcimage_name,$refimage_name, $read_options,
292      $normalized_mean_error_max, $normalized_maximum_error_max) = @_;
293  my($srcimage, $refimage, $normalized_mean_error, $normalized_maximum_error);
294
295  $errorinfo='';
296  $normalized_mean_error_max+=1.0e-12;
297  $normalized_maximum_error_max+=1.0e-12;
298
299  # Create images
300  $srcimage=Image::Magick->new;
301  $refimage=Image::Magick->new;
302
303  if ( "$read_options" ne "" ) {
304    eval "\$status=\$srcimage->Set($read_options);";
305    if ("$status")
306      {
307        $errorinfo = "Set($read_options): $status";
308        warn("$errorinfo");
309        goto COMPARE_RUNTIME_ERROR;
310      }
311  }
312
313  $status=$srcimage->ReadImage("$srcimage_name");
314  if ("$status")
315    {
316      $errorinfo = "Readimage ($srcimage_name): $status";
317      warn("$errorinfo");
318      goto COMPARE_RUNTIME_ERROR;
319    }
320
321# if ("$srcimage_name" eq "input.tim") {
322#    $srcimage->write(filename=>"$refimage_name", compression=>'None');
323#  }
324
325  #print("writing file $refimage_name\n");
326  #$srcimage->Quantize(colors=>256);
327  #$status=$srcimage->write(filename=>"$refimage_name", compression=>'rle');
328  #warn "$status" if $status;
329
330  $status=$refimage->ReadImage("$refimage_name");
331  if ("$status")
332    {
333      $errorinfo = "Readimage ($refimage_name): $status";
334       warn("$errorinfo");
335      goto COMPARE_RUNTIME_ERROR;
336    }
337
338  $srcimage->Clamp();
339  $srcimage->set(depth=>8);
340
341  # FIXME: The following statement should not be needed.
342#  $status=$refimage->Set(type=>'TrueColor');
343#  if ("$status")
344#    {
345#      $errorinfo = "Set(type=>'TrueColor'): $status";
346#      goto COMPARE_RUNTIME_ERROR;
347#    }
348
349  # Verify that $srcimage and $refimage contain the same number of frames.
350  if ( $#srcimage != $#refimage )
351    {
352      $errorinfo = "Source and reference images contain different number of frames ($#srcimage != $#refimage)";
353      warn("$errorinfo");
354      goto COMPARE_RUNTIME_ERROR;
355    }
356
357  # Compare each frame in the sequence.
358  for ($index = 0; $srcimage->[$index] && $refimage->[$index]; $index++)
359    {
360      $status=$srcimage->[$index]->Difference($refimage->[$index]);
361      if ("$status")
362        {
363          $errorinfo = "Difference($refimage_name)->[$index]: $status";
364          warn("$errorinfo");
365          goto COMPARE_RUNTIME_ERROR;
366        }
367    }
368
369
370  $normalized_mean_error=0;
371  $normalized_mean_error=$srcimage->GetAttribute('mean-error');
372  if ( !defined($normalized_mean_error) )
373    {
374      $errorinfo = "GetAttribute('mean-error') returned undefined value!";
375      warn("$errorinfo");
376      goto COMPARE_RUNTIME_ERROR;
377    }
378  $normalized_maximum_error=0;
379  $normalized_maximum_error=$srcimage->GetAttribute('maximum-error');
380  if ( ! defined($normalized_maximum_error) )
381    {
382      $errorinfo = "GetAttribute('maximum-error') returned undefined value!";
383      warn("$errorinfo");
384      goto COMPARE_RUNTIME_ERROR;
385    }
386  if ( ($normalized_mean_error > $normalized_mean_error_max) ||
387       ($normalized_maximum_error > $normalized_maximum_error_max) )
388    {
389      print("mean-error=$normalized_mean_error, maximum-error=$normalized_maximum_error\n");
390      #$srcimage->Display();
391      print "not ok $test\n";
392      return 1
393    }
394
395  undef $srcimage;
396  undef $refimage;
397  print "ok $test\n";
398  return 0;
399
400 COMPARE_RUNTIME_ERROR:
401  undef $srcimage;
402  undef $refimage;
403  print "not ok $test\n";
404  return 1
405}
406
407#
408# Test reading a file which requires a file size to read (GRAY, RGB, CMYK)
409# or supports multiple resolutions (JBIG, JPEG, PCD)
410#
411# Usage: testRead( read filename, size, depth, expected ref_8 [, expected ref_16] [, expected ref_32] );
412#
413sub testReadSized {
414  my( $infile, $size, $ref_8, $ref_16, $ref_32 ) =  @_;
415
416  my($image,$ref_signature);
417
418  if ( !defined( $ref_16 ) )
419    {
420      $ref_16 = $ref_8;
421    }
422  if ( !defined( $ref_32 ) )
423    {
424      $ref_32 = $ref_16;
425    }
426
427  if (Image::Magick->new()->QuantumDepth == 32)
428    {
429      $ref_signature=$ref_32;
430    }
431  elsif (Image::Magick->new()->QuantumDepth == 16)
432    {
433      $ref_signature=$ref_16;
434    }
435  else
436    {
437      $ref_signature=$ref_8;
438    }
439
440  $image=Image::Magick->new;
441
442  # Set size attribute
443  $status=$image->SetAttribute(size=>"$size");
444  warn "$status" if "$status";
445
446  # If depth is not zero, then set it
447  if ( Image::Magick->new()->QuantumDepth != 0 ) {
448    $status=$image->SetAttribute(depth=>Image::Magick->new()->QuantumDepth);
449    warn "$status" if "$status";
450  }
451
452  $status=$image->ReadImage("$infile");
453  if( "$status" ) {
454    print "ReadImage $infile: $status";
455    print "not ok $test\n";
456  } else {
457    $signature=$image->Get('signature');
458      if ( $signature ne $ref_signature ) {
459        print "ReadImage()\n";
460      	print "Image: $infile, signatures do not match.\n";
461      	print "     Expected: $ref_signature\n";
462      	print "     Computed: $signature\n";
463        print "     Depth:    ", Image::Magick->new()->QuantumDepth, "\n";
464        print "not ok $test\n";
465        #$image->Display();
466      } else {
467        print "ok $test\n";
468    }
469  }
470}
471
472#
473# Test writing a file by first reading a source image, writing to a new image,
474# reading the written image, and comparing with expected REF_8.
475#
476# Usage: testReadWrite( read filename, write filename, write options,
477#    expected ref_8 [, expected ref_16] );
478#
479# .e.g
480#
481# testReadWrite( 'input.jpg', 'output.jpg', q/quality=>80, interlace=>'None'/,
482#                'dc0a144a0b9480cd1e93757a30f01ae3' );
483#
484# If the REF_8 of the written image is not what is expected, the written
485# image is preserved.  Otherwise, the written image is removed.
486#
487sub testReadWrite {
488  my( $infile, $outfile, $writeoptions, $ref_8, $ref_16, $ref_32 ) = @_;
489
490  my($image);
491
492  if ( !defined( $ref_16 ) )
493    {
494      $ref_16 = $ref_8;
495    }
496  if ( !defined( $ref_32 ) )
497    {
498      $ref_32 = $ref_16;
499    }
500
501  if (Image::Magick->new()->QuantumDepth == 32)
502    {
503      $ref_signature=$ref_32;
504    }
505  elsif (Image::Magick->new()->QuantumDepth == 16)
506    {
507      $ref_signature=$ref_16;
508    }
509  else
510    {
511      $ref_signature=$ref_8;
512    }
513
514  $image=Image::Magick->new;
515  $status=$image->ReadImage("$infile");
516  $signature=$image->Get('signature');
517  if( "$status" ) {
518    print "ReadImage $infile: $status\n";
519    print "not ok $test\n";
520  } else {
521    # Write image to file
522    my $options = 'filename=>"$outfile", ' . "$writeoptions";
523    #print "Using options: $options\n";
524    eval "\$status=\$image->WriteImage( $options ) ;";
525    if( $@ ) {
526      print "$@\n";
527      print "not ok $test\n";
528      exit 1;
529    }
530    if( "$status" ) {
531      print "WriteImage $outfile: $status\n";
532      print "not ok $test\n";
533    } else {
534      my($image);
535
536      # Read image just written
537      $image=Image::Magick->new;
538      $status=$image->ReadImage("$outfile");
539      if( "$status" ) {
540        print "ReadImage $outfile: $status\n";
541        print "not ok $test\n";
542      } else {
543        # Check signature
544        $signature=$image->Get('signature');
545        if ( $signature ne $ref_signature ) {
546          print "ReadImage()\n";
547          print "Image: $infile, signatures do not match.\n";
548          print "     Expected: $ref_signature\n";
549          print "     Computed: $signature\n";
550          print "     Depth:    ", Image::Magick->new()->QuantumDepth, "\n";
551          print "not ok $test\n";
552          $image->Display();
553        } else {
554          print "ok $test\n";
555          ($file = $outfile) =~ s/.*://g;
556          #unlink "$file";
557        }
558      }
559    }
560  }
561}
562
563#
564# Test reading a file, and compare with a reference file
565#
566sub testReadWriteCompare {
567  my( $srcimage_name, $outimage_name, $refimage_name,
568      $read_options, $write_options,
569      $normalized_mean_error_max, $normalized_maximum_error_max) = @_;
570  my($srcimage, $refimage, $normalized_mean_error,
571    $normalized_maximum_error);
572
573  $errorinfo='';
574  $normalized_mean_error_max+=1.0e-12;
575  $normalized_maximum_error_max+=1.0e-12;
576
577  $image=Image::Magick->new;
578  $refimage=Image::Magick->new;
579
580  #
581  # Read the initial image
582  #
583  $status=$image->ReadImage($srcimage_name);
584  if ("$status")
585    {
586      $errorinfo = "Readimage ($srcimage_name): $status";
587      goto COMPARE_RUNTIME_ERROR;
588    }
589
590  #
591  # Write image to output file
592  #
593  if ( "$write_options" ne "" ) {
594    eval "\$status=\$image->Set($write_options);";
595    if ("$status")
596      {
597        $errorinfo = "Set($write_options): $status";
598        goto COMPARE_RUNTIME_ERROR;
599      }
600  }
601  $image->Set(filename=>"$outimage_name");
602
603  $status=$image->WriteImage( );
604  if ("$status")
605    {
606      $errorinfo = "WriteImage ($outimage_name): $status";
607      goto COMPARE_RUNTIME_ERROR;
608    }
609
610  undef $image;
611  $image=Image::Magick->new;
612
613  #
614  # Read image from output file
615  #
616  if ( "$read_options" ne "" ) {
617    eval "\$status=\$image->Set($read_options);";
618    if ("$status")
619      {
620        $errorinfo = "Set($read_options): $status";
621        goto COMPARE_RUNTIME_ERROR;
622      }
623  }
624
625  $image->ReadImage("$outimage_name");
626  if ("$status")
627    {
628      $errorinfo = "WriteImage ($outimage_name): $status";
629      goto COMPARE_RUNTIME_ERROR;
630    }
631
632# eval "\$status=\$image->Set($write_options);";
633#$status=$image->write(filename=>"$refimage_name", compression=>'None');
634# warn "$status" if $status;
635
636  #
637  # Read reference image
638  #
639  $status=$refimage->ReadImage("$refimage_name");
640  if ("$status")
641    {
642      $errorinfo = "Readimage ($refimage_name): $status";
643      goto COMPARE_RUNTIME_ERROR;
644    }
645
646  #
647  # Compare output file with reference image
648  #
649
650  $image->Clamp();
651  $image->set(depth=>8);
652
653  # FIXME: The following statement should not be needed.
654#  $status=$refimage->Set(type=>'TrueColor');
655#  if ("$status")
656#    {
657#      $errorinfo = "Set(type=>'TrueColor'): $status";
658#      goto COMPARE_RUNTIME_ERROR;
659#    }
660
661  $status=$image->Difference($refimage);
662  if ("$status")
663    {
664      $errorinfo = "Difference($refimage_name): $status";
665      goto COMPARE_RUNTIME_ERROR;
666    }
667
668  $normalized_mean_error=0;
669  $normalized_mean_error=$image->GetAttribute('mean-error');
670  if ( !defined($normalized_mean_error) )
671    {
672      $errorinfo = "GetAttribute('mean-error') returned undefined value!";
673      goto COMPARE_RUNTIME_ERROR;
674    }
675  $normalized_maximum_error=0;
676  $normalized_maximum_error=$image->GetAttribute('maximum-error');
677  if ( ! defined($normalized_maximum_error) )
678    {
679      $errorinfo = "GetAttribute('maximum-error') returned undefined value!";
680      goto COMPARE_RUNTIME_ERROR;
681    }
682
683  if ( ($normalized_mean_error > $normalized_mean_error_max) ||
684       ($normalized_maximum_error > $normalized_maximum_error_max) )
685    {
686      print("mean-error=$normalized_mean_error, maximum-error=$normalized_maximum_error\n");
687      print "not ok $test\n";
688      return 1
689    }
690
691  print "ok $test\n";
692  undef $image;
693  undef $refimage;
694  return 0;
695
696 COMPARE_RUNTIME_ERROR:
697  warn("$errorinfo");
698  print "not ok $test\n";
699  undef $image;
700  undef $refimage;
701  return 1
702}
703
704#
705# Test writing a file by first reading a source image, writing to a
706# new image, and reading the written image.  Depends on detecting
707# reported errors by ImageMagick
708#
709# Usage: testReadWrite( read filename, write filename, write options);
710#
711# .e.g
712#
713# testReadWrite( 'input.jpg', 'output.jpg', q/quality=>80, 'interlace'=>'None'/ );
714#
715# If the read of the written image is not what is expected, the
716# written image is preserved.  Otherwise, the written image is
717# removed.
718#
719sub testReadWriteNoVerify {
720  my( $infile, $outfile, $writeoptions) = @_;
721
722  my($image, $images);
723
724  $image=Image::Magick->new;
725  $status=$image->ReadImage("$infile");
726  if( "$status" ) {
727    print "$status\n";
728    print "ReadImage $infile: not ok $test\n";
729  } else {
730    # Write image to file
731    my $options = 'filename=>"$outfile", ' . $writeoptions;
732    #print "Using options: $options\n";
733    eval "\$status=\$image->WriteImage( $options ) ;";
734    if( $@ ) {
735      print "$@";
736      print "not ok $test\n";
737      exit 1;
738    }
739    if( "$status" ) {
740      print "WriteImage $outfile: $status\n";
741      print "not ok $test\n";
742    } else {
743      my($image);
744
745      # Read image just written
746      $image=Image::Magick->new;
747      $status=$image->ReadImage("$outfile");
748      if( "$status" ) {
749        print "ReadImage $outfile: $status\n";
750        print "not ok $test\n";
751      } else {
752        print "ok $test\n";
753        unlink $outfile;
754      }
755    }
756  }
757}
758
759#
760# Test writing a file by first reading a source image, writing to a new image,
761# reading the written image, and comparing with expected REF_8.
762#
763# Usage: testReadWriteSized( read filename,
764#                            write filename,
765#                            read filename size,
766#                            read filename depth,
767#                            write options,
768#                            expected ref_8 [,expected ref_16] );
769#
770# .e.g
771#
772# testReadWriteSized( 'input.jpg', 'output.jpg', '70x46', 8, q/quality=>80,
773#                     'interlace'=>'None'/, 'dc0a144a0b9480cd1e93757a30f01ae3' );
774#
775# If the REF_8 of the written image is not what is expected, the written
776# image is preserved.  Otherwise, the written image is removed.  A depth of 0 is
777# ignored.
778#
779sub testReadWriteSized {
780  my( $infile, $outfile, $size, $readdepth, $writeoptions, $ref_8, $ref_16,
781      $ref_32 ) = @_;
782
783  my($image, $ref_signature);
784
785  if ( !defined( $ref_16 ) )
786    {
787      $ref_16 = $ref_8;
788    }
789  if ( !defined( $ref_32 ) )
790    {
791      $ref_32 = $ref_16;
792    }
793
794  if (Image::Magick->new()->QuantumDepth == 32)
795    {
796      $ref_signature=$ref_32;
797    }
798  elsif (Image::Magick->new()->QuantumDepth == 16)
799    {
800      $ref_signature=$ref_16;
801    }
802  else
803    {
804      $ref_signature=$ref_8;
805    }
806
807  $image=Image::Magick->new;
808
809  #$image->SetAttribute(debug=>'transform');
810
811  # Set size attribute
812  $status=$image->SetAttribute(size=>"$size");
813  warn "$status" if "$status";
814
815  # If read depth is not zero, then set it
816  if ( $readdepth != 0 ) {
817    $status=$image->SetAttribute(depth=>$readdepth);
818    warn "$status" if "$status";
819  }
820
821  $status=$image->ReadImage("$infile");
822  if( "$status" ) {
823    print "ReadImage $infile: $status\n";
824    print "not ok $test\n";
825  } else {
826    # Write image to file
827    my $options = 'filename=>"$outfile", ' . "$writeoptions";
828    #print "Using options: $options\n";
829    eval "\$status=\$image->WriteImage( $options ) ;";
830    if( $@ ) {
831      print "$@\n";
832      print "not ok $test\n";
833      exit 1;
834    }
835    if( "$status" ) {
836      print "WriteImage $outfile: $status\n";
837      print "not ok $test\n";
838    } else {
839      my($image);
840
841      $image=Image::Magick->new;
842
843      if ( $readdepth != 0 ) {
844        $status=$image->SetAttribute(depth=>$readdepth);
845        warn "$status" if "$status";
846      }
847      # Set image size attribute
848      $status=$image->SetAttribute(size=>"$size");
849      warn "$status" if "$status";
850
851      # Read image just written
852      $status=$image->ReadImage("$outfile");
853      if( "$status" ) {
854        print "ReadImage $outfile: $status\n";
855        print "not ok $test\n";
856      } else {
857        # Check signature
858        $signature=$image->Get('signature');
859
860        if ( $signature ne $ref_signature ) {
861          print "ReadImage()\n";
862          print "Image: $infile, signatures do not match.\n";
863          print "     Expected: $ref_signature\n";
864          print "     Computed: $signature\n";
865          print "     Depth:    ", Image::Magick->new()->QuantumDepth, "\n";
866          print "not ok $test\n";
867          #$image->Display();
868        } else {
869          print "ok $test\n";
870          #$image->Display();
871          ($file = $outfile) =~ s/.*://g;
872          unlink "$file";
873        }
874      }
875    }
876  }
877}
878
879#
880# Test SetAttribute method
881#
882# Usage: testSetAttribute( name, attribute);
883#
884sub testSetAttribute {
885  my( $srcimage, $name, $attribute ) = @_;
886
887  my($image);
888
889  # Create temporary image
890  $image=Image::Magick->new;
891
892  $status=$image->ReadImage("$srcimage");
893  warn "Readimage: $status" if "$status";
894
895  # Set image option
896  print "Image Option  : $name=>$attribute\n";
897  eval "\$status = \$image->Set('$name'=>'$attribute') ;";
898  warn "SetImage: $status" if "$status";
899
900  # Convert input values to expected output values
901  $expected=$attribute;
902  if ($attribute eq 'True' || $attribute eq 'true') {
903    $expected = 1;
904  } elsif ($attribute eq 'False' || $attribute eq 'false') {
905    $expected = 0;
906  }
907
908
909  $value=$image->GetAttribute($name);
910
911  if( defined( $value ) ) {
912    if ("$expected" eq "$value") {
913      print "ok $test\n";
914    } else {
915      print "Expected ($expected), Got ($value)\n";
916      print "not ok $test\n";
917    }
918  } else {
919    print "GetAttribute returned undefined value!\n";
920    print "not ok $test\n";
921  }
922}
923
924#
925# Test GetAttribute method
926#
927# Usage: testGetAttribute( name, expected);
928#
929sub testGetAttribute {
930  my( $srcimage, $name, $expected ) = @_;
931
932  my($image);
933
934  # Create temporary image
935  $image=Image::Magick->new;
936
937  $status=$image->ReadImage("$srcimage");
938  warn "Readimage: $status" if "$status";
939
940  $value=$image->GetAttribute($name);
941
942  if( !defined( $expected ) && !defined( $value ) ) {
943    # Undefined value is expected
944    print "ok $test\n";
945  } elsif ( !defined( $value ) ) {
946    print "Expected ($expected), Got (undefined)\n";
947    print "not ok $test\n";
948  } else {
949    if ("$expected" eq "$value") {
950      print "ok $test\n";
951    } else {
952      print "Expected ($expected), Got ($value)\n";
953      print "not ok $test\n";
954    }
955  }
956}
957
958#
959# Test MontageImage method
960#
961# Usage: testMontage( input image attributes, montage options, expected REF_8
962#       [, expected REF_16] );
963#
964sub testMontage {
965  my( $imageOptions, $montageOptions, $ref_8, $ref_16, $ref_32, $ref_32_hdri ) = @_;
966
967  my($image,$ref_signature);
968
969  if ( !defined( $ref_16 ) )
970    {
971      $ref_16 = $ref_8;
972    }
973  if ( !defined( $ref_32 ) )
974    {
975      $ref_32 = $ref_16;
976    }
977
978  # Create image for image list
979  $images=Image::Magick->new;
980
981  # Create temporary image
982  $image=Image::Magick->new;
983
984  my @colors = ( '#000000', '#008000', '#C0C0C0', '#00FF00',
985                 '#808080', '#808000', '#FFFFFF', '#FFFF00',
986                 '#800000', '#000080', '#FF0000', '#0000FF',
987                 '#800080', '#008080', '#FF00FF', '#00FFFF' );
988
989  my $color;
990  foreach $color ( @colors ) {
991
992    # Generate image
993    $image->Set(size=>'50x50');
994    #print("\$image->ReadImage(xc:$color);\n");
995    $status=$image->ReadImage("xc:$color");
996    if ("$status") {
997      warn "Readimage: $status" if "$status";
998    } else {
999      # Add image to list
1000      push( @$images, @$image);
1001    }
1002    undef @$image;
1003  }
1004
1005  # Set image options
1006  if ("$imageOptions" ne "") {
1007    print("\$images->Set($imageOptions)\n");
1008    eval "\$status = \$images->Set($imageOptions) ;";
1009    warn "SetImage: $status" if "$status";
1010  }
1011
1012  #print "Border color : ", $images->Get('bordercolor'), "\n";
1013  #print "Matte color  : ", $images->Get('mattecolor'), "\n";
1014  #print "Pen color    : ", $images->Get('pen'), "\n";
1015
1016  # Do montage
1017  #print "Montage Options: $montageOptions\n";
1018  print("\$montage=\$images->Montage( $montageOptions )\n");
1019  eval "\$montage=\$images->Montage( $montageOptions ) ;";
1020  #$montage->Clamp();
1021  if( $@ ) {
1022    print "$@";
1023    print "not ok $test\n";
1024    return 1;
1025  }
1026
1027  if( ! ref($montage) ) {
1028    print "not ok $test\n";
1029  } else {
1030    # Check REF_8 signature
1031    # $montage->Display();
1032    $signature=$montage->GetAttribute('signature');
1033    if ( defined( $signature ) ) {
1034      if ( $signature ne $ref_8 && $signature ne $ref_16 && $signature ne $ref_32 && $signature ne $ref_32_hdri) {
1035        print "ReadImage()\n";
1036        print "Test $test, signatures do not match.\n";
1037      	print "     Expected: $ref_8\n";
1038      	print "     Computed: $signature\n";
1039        print "     Depth:    ", Image::Magick->new()->QuantumDepth, "\n";
1040        $status = $montage->Write("test_${test}_out.miff");
1041        warn "Write: $status" if "$status";
1042
1043        print "not ok $test\n";
1044      } else {
1045        # Check montage directory
1046        my $directory = $montage->Get('directory');
1047        my $expected = join( "\xff", @colors ) . "\xff";
1048        if ( !defined($directory) ) {
1049          print "ok $test\n";
1050        } elsif ( $directory  ne $expected) {
1051          print("Invalid montage directory:\n\"$directory\"\n");
1052          print("Expected:\n\"$expected\"\n");
1053          print "not ok $test\n";
1054        } else {
1055          # Check montage geometry
1056          $montage_geom=$montage->Get('montage');
1057          if( !defined($montage_geom) ) {
1058            print("Montage geometry not defined!\n");
1059            print "not ok $test\n";
1060          } elsif ( $montage_geom !~ /^\d+x\d+\+\d+\+\d+$/ ) {
1061            print("Montage geometry not in correct format: \"$montage_geom\"\n");
1062            print "not ok $test\n";
1063          } else {
1064            print "ok $test\n";
1065          }
1066        }
1067      }
1068    } else {
1069      warn "GetAttribute returned undefined value!";
1070      print "not ok $test\n";
1071    }
1072  }
1073}
1074
1075#
1076# Test filter method using signature compare
1077#
1078# Usage: testFilterSignature( input image attributes, filter, options, expected REF_8
1079#      [, expected REF_16] );
1080#
1081sub testFilterSignature {
1082  my( $srcimage, $filter, $filter_options, $ref_8, $ref_16, $ref_32 ) = @_;
1083
1084  my($image, $ref_signature);
1085
1086#  print( $filter, " ...\n" );
1087
1088  if ( !defined( $ref_16 ) )
1089    {
1090      $ref_16 = $ref_8;
1091    }
1092  if ( !defined( $ref_32 ) )
1093    {
1094      $ref_32 = $ref_16;
1095    }
1096
1097  if (Image::Magick->new()->QuantumDepth == 32)
1098    {
1099      $ref_signature=$ref_32;
1100    }
1101  elsif (Image::Magick->new()->QuantumDepth == 16)
1102    {
1103      $ref_signature=$ref_16;
1104    }
1105  else
1106    {
1107      $ref_signature=$ref_8;
1108    }
1109
1110  # Create temporary image
1111  $image=Image::Magick->new;
1112
1113  $status=$image->ReadImage("$srcimage");
1114  warn "Readimage: $status" if "$status";
1115
1116  print("$filter\($filter_options\) ...\n");
1117  $image->$filter($filter_options);
1118#$image->write(filename=>"reference/filter/$filter.miff", compression=>'None');
1119
1120  $signature=$image->GetAttribute('signature');
1121  if ( defined( $signature ) ) {
1122    if ( $signature ne $ref_signature ) {
1123      print "Test $test, signatures do not match.\n";
1124      print "     Expected: $ref_signature\n";
1125      print "     Computed: $signature\n";
1126      print "     Depth:    ", Image::Magick->new()->QuantumDepth, "\n";
1127      #$image->Display();
1128      print "not ok $test\n";
1129    } else {
1130      print "ok $test\n";
1131    }
1132  } else {
1133    warn "GetAttribute returned undefined value!";
1134    print "not ok $test\n";
1135  }
1136}
1137
1138#
1139# Test filter method using comparison with reference image
1140#
1141# Usage: testFilterCompare( input image, input image options, reference image, filter, filter options,
1142#                           normalized_mean_error,
1143#                           normalized_maximum_error );
1144sub testFilterCompare {
1145  my ($srcimage_name, $src_read_options, $refimage_name, $filter,
1146      $filter_options, $normalized_mean_error_max,
1147      $normalized_maximum_error_max) = @_;
1148  my($srcimage, $refimage, $normalized_mean_error,
1149    $normalized_maximum_error);
1150  my($status,$errorinfo);
1151
1152  $errorinfo='';
1153  $status='';
1154  $normalized_mean_error_max+=1.0e-12;
1155  $normalized_maximum_error_max+=1.0e-12;
1156
1157  #print( $filter, " ...\n" );
1158
1159  # Create images
1160  $srcimage=Image::Magick->new;
1161  $refimage=Image::Magick->new;
1162
1163  if ( "$src_read_options" ne "" ) {
1164    print("Set($src_read_options) ...\n");
1165    eval "\$status=\$srcimage->Set($src_read_options);";
1166    if ("$status")
1167      {
1168        $errorinfo = "Set($src_read_options): $status";
1169        goto COMPARE_RUNTIME_ERROR;
1170      }
1171  }
1172
1173  $status=$srcimage->ReadImage($srcimage_name);
1174  #eval "\$status=\$srcimage->ReadImage($srcimage_name);";
1175  if ("$status")
1176    {
1177      $errorinfo = "Readimage ($srcimage_name): $status";
1178      goto COMPARE_RUNTIME_ERROR;
1179    }
1180
1181  print("$filter\($filter_options\) ...\n");
1182  eval "\$status=\$srcimage->$filter($filter_options);";
1183  if ("$status")
1184    {
1185      $errorinfo = "$filter ($filter_options): $status";
1186      goto COMPARE_RUNTIME_ERROR;
1187    }
1188
1189  $srcimage->Clamp();
1190  $srcimage->set(depth=>8);
1191#  if ("$filter" eq "Shear") {
1192#    $srcimage->Display();
1193#    $srcimage->write(filename=>"$refimage_name", compression=>'None');
1194#  }
1195
1196  $status=$refimage->ReadImage("$refimage_name");
1197  if ("$status")
1198    {
1199      $errorinfo = "Readimage ($refimage_name): $status";
1200      goto COMPARE_RUNTIME_ERROR;
1201    }
1202
1203  # FIXME: The following statement should not be needed.
1204#  $status=$refimage->Set(type=>'TrueColor');
1205#  if ("$status")
1206#    {
1207#      $errorinfo = "Set(type=>'TrueColor'): $status";
1208#      goto COMPARE_RUNTIME_ERROR;
1209#    }
1210
1211  $status=$srcimage->Difference($refimage);
1212  if ("$status")
1213    {
1214      $errorinfo = "Difference($refimage_name): $status";
1215      print("  Reference: ", $refimage->Get('columns'), "x", $refimage->Get('rows'), "\n");
1216      print("  Computed:  ", $srcimage->Get('columns'), "x", $srcimage->Get('rows'), "\n");
1217      goto COMPARE_RUNTIME_ERROR;
1218    }
1219
1220  $normalized_mean_error=0;
1221  $normalized_mean_error=$srcimage->GetAttribute('mean-error');
1222  if ( !defined($normalized_mean_error) )
1223    {
1224      $errorinfo = "GetAttribute('mean-error') returned undefined value!";
1225      goto COMPARE_RUNTIME_ERROR;
1226    }
1227  $normalized_maximum_error=0;
1228  $normalized_maximum_error=$srcimage->GetAttribute('maximum-error');
1229  if ( ! defined($normalized_maximum_error) )
1230    {
1231      $errorinfo = "GetAttribute('maximum-error') returned undefined value!";
1232      goto COMPARE_RUNTIME_ERROR;
1233    }
1234  if ( ($normalized_mean_error > $normalized_mean_error_max) ||
1235       ($normalized_maximum_error > $normalized_maximum_error_max) )
1236    {
1237      print("  mean-error=$normalized_mean_error, maximum-error=$normalized_maximum_error\n");
1238      print "not ok $test\n";
1239      #$srcimage->Display();
1240      undef $srcimage;
1241      undef $refimage;
1242      return 1
1243    }
1244
1245  undef $srcimage;
1246  undef $refimage;
1247  print "ok $test\n";
1248  return 0;
1249
1250 COMPARE_RUNTIME_ERROR:
1251  undef $srcimage;
1252  undef $refimage;
1253  print("  $errorinfo\n");
1254  print "not ok $test\n";
1255  return 1
1256}
12571;
1258