Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 66 lines (60 sloc) 2.561 kb
a7e32be @tonycoz add simple tests for the Imager::Test test_image functions
authored
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 }
Something went wrong with that request. Please try again.