granicus.if.org Git - imagemagick/blob - PerlMagick/t/subroutines.pl

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