Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 66 lines (60 sloc) 2.561 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
#!perl -w
use strict;
use Imager;
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);
use Test::More tests => 60;

# test Imager::Test

for my $named (0, 1) {
  my $named_desc = $named ? " (by name)" : "";
  {
    my $im = $named ? test_image_named("basic") : test_image();
    ok($im, "got basic test image$named_desc");
    is($im->type, "direct", "check basic image type");
    is($im->getchannels, 3, "check basic image channels");
    is($im->bits, 8, "check basic image bits");
    ok(!$im->is_bilevel, "check basic isn't mono");
  }
  {
    my $im = $named ? test_image_named("basic16") : test_image_16();
    ok($im, "got 16-bit basic test image$named_desc");
    is($im->type, "direct", "check 16-bit basic image type");
    is($im->getchannels, 3, "check 16-bit basic image channels");
    is($im->bits, 16, "check 16-bit basic image bits");
    ok(!$im->is_bilevel, "check 16-bit basic isn't mono");
  }
  
  {
    my $im = $named ? test_image_named("basic_double") : test_image_double();
    ok($im, "got double basic test image$named_desc");
    is($im->type, "direct", "check double basic image type");
    is($im->getchannels, 3, "check double basic image channels");
    is($im->bits, "double", "check double basic image bits");
    ok(!$im->is_bilevel, "check double basic isn't mono");
  }
  {
    my $im = $named ? test_image_named("gray") : test_image_gray();
    ok($im, "got gray test image$named_desc");
    is($im->type, "direct", "check gray image type");
    is($im->getchannels, 1, "check gray image channels");
    is($im->bits, 8, "check gray image bits");
    ok(!$im->is_bilevel, "check gray isn't mono");
    $im->write(file => "testout/t03gray.pgm");
  }
  
  {
    my $im = $named ? test_image_named("gray16") : test_image_gray_16();
    ok($im, "got gray test image$named_desc");
    is($im->type, "direct", "check 16-bit gray image type");
    is($im->getchannels, 1, "check 16-bit gray image channels");
    is($im->bits, 16, "check 16-bit gray image bits");
    ok(!$im->is_bilevel, "check 16-bit isn't mono");
    $im->write(file => "testout/t03gray16.pgm");
  }
  
  {
    my $im = $named ? test_image_named("mono") : test_image_mono();
    ok($im, "got mono image$named_desc");
    is($im->type, "paletted", "check mono image type");
    is($im->getchannels, 3, "check mono image channels");
    is($im->bits, 8, "check mono image bits");
    ok($im->is_bilevel, "check mono is mono");
    $im->write(file => "testout/t03mono.pbm");
  }
}
Something went wrong with that request. Please try again.