t/t03test.t

   1 #!perl -w
   2 use strict;
   3 use Imager;
   4 use Imager::Test qw(test_image test_image_16 test_image_mono test_image_gray test_image_gray_16 test_image_double test_image_named);
   5 use Test::More tests => 60;
   6
   7 # test Imager::Test
   8
   9 for my $named (0, 1) {
  10   my $named_desc = $named ? " (by name)" : "";
  11   {
  12     my $im = $named ? test_image_named("basic") : test_image();
  13     ok($im, "got basic test image$named_desc");
  14     is($im->type, "direct", "check basic image type");
  15     is($im->getchannels, 3, "check basic image channels");
  16     is($im->bits, 8, "check basic image bits");
  17     ok(!$im->is_bilevel, "check basic isn't mono");
  18   }
  19   {
  20     my $im = $named ? test_image_named("basic16") : test_image_16();
  21     ok($im, "got 16-bit basic test image$named_desc");
  22     is($im->type, "direct", "check 16-bit basic image type");
  23     is($im->getchannels, 3, "check 16-bit basic image channels");
  24     is($im->bits, 16, "check 16-bit basic image bits");
  25     ok(!$im->is_bilevel, "check 16-bit basic isn't mono");
  26   }
  27
  28   {
  29     my $im = $named ? test_image_named("basic_double") : test_image_double();
  30     ok($im, "got double basic test image$named_desc");
  31     is($im->type, "direct", "check double basic image type");
  32     is($im->getchannels, 3, "check double basic image channels");
  33     is($im->bits, "double", "check double basic image bits");
  34     ok(!$im->is_bilevel, "check double basic isn't mono");
  35   }
  36   {
  37     my $im = $named ? test_image_named("gray") : test_image_gray();
  38     ok($im, "got gray test image$named_desc");
  39     is($im->type, "direct", "check gray image type");
  40     is($im->getchannels, 1, "check gray image channels");
  41     is($im->bits, 8, "check gray image bits");
  42     ok(!$im->is_bilevel, "check gray isn't mono");
  43     $im->write(file => "testout/t03gray.pgm");
  44   }
  45
  46   {
  47     my $im = $named ? test_image_named("gray16") : test_image_gray_16();
  48     ok($im, "got gray test image$named_desc");
  49     is($im->type, "direct", "check 16-bit gray image type");
  50     is($im->getchannels, 1, "check 16-bit gray image channels");
  51     is($im->bits, 16, "check 16-bit gray image bits");
  52     ok(!$im->is_bilevel, "check 16-bit isn't mono");
  53     $im->write(file => "testout/t03gray16.pgm");
  54   }
  55
  56   {
  57     my $im = $named ? test_image_named("mono") : test_image_mono();
  58     ok($im, "got mono image$named_desc");
  59     is($im->type, "paletted", "check mono image type");
  60     is($im->getchannels, 3, "check mono image channels");
  61     is($im->bits, 8, "check mono image bits");
  62     ok($im->is_bilevel, "check mono is mono");
  63     $im->write(file => "testout/t03mono.pbm");
  64   }
  65 }