Skip to content
Newer
Older
100644 152 lines (132 sloc) 4.76 KB
6175309 convert to Test::More
Tony Cook authored
1 #!perl -w
2 use strict;
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
3 use Imager qw(:all :handy);
26eb06d @tonycoz [rt #79922] catch an invalid matrix supplied to convert()
authored
4 use Test::More tests => 29;
6286932 reorganize convert.c to convert.im
Tony Cook authored
5 use Imager::Test qw(test_colorf_gpix is_fcolor1 is_fcolor3);
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
6
40e78f9 @tonycoz RT#65088 make sure each test script that needs testout/ creates it
authored
7 -d "testout" or mkdir "testout";
8
6175309 convert to Test::More
Tony Cook authored
9 Imager::init("log"=>'testout/t67convert.log');
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
10
11 my $imbase = Imager::ImgRaw::new(200,300,3);
12
13 # first a basic test, make sure the basic things happen ok
14 # make a 1 channel image from the above (black) image
15 # but with 1 as the 'extra' value
6175309 convert to Test::More
Tony Cook authored
16 SKIP:
17 {
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
18 my $im_white = i_convert($imbase, [ [ 0, 0, 0, 1 ] ]);
6175309 convert to Test::More
Tony Cook authored
19 skip("convert to white failed", 3)
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
20 unless ok($im_white, "convert to white");
6175309 convert to Test::More
Tony Cook authored
21
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
22 my ($w, $h, $ch) = i_img_info($im_white);
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
23
24 # the output image should now have one channel
6175309 convert to Test::More
Tony Cook authored
25 is($ch, 1, "one channel image now");
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
26 # should have the same width and height
6175309 convert to Test::More
Tony Cook authored
27 ok($w == 200 && $h == 300, "check converted size is the same");
28
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
29 # should be a white image now, let's check
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
30 my $c = Imager::i_get_pixel($im_white, 20, 20);
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
31 my @c = $c->rgba;
32 print "# @c\n";
6175309 convert to Test::More
Tony Cook authored
33 is($c[0], 255, "check image is white");
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
34 }
35
36 # test the highlevel interface
37 # currently this requires visual inspection of the output files
38 my $im = Imager->new;
6175309 convert to Test::More
Tony Cook authored
39 SKIP:
40 {
41 skip("could not load scale.ppm", 3)
42 unless $im->read(file=>'testimg/scale.ppm');
43 my $out = $im->convert(preset=>'gray');
44 ok($out, "convert preset gray");
45 ok($out->write(file=>'testout/t67_gray.ppm', type=>'pnm'),
46 "save grey image");
47 $out = $im->convert(preset=>'blue');
48 ok($out, "convert preset blue");
faa9b3e Egads
Tony Cook authored
49
6175309 convert to Test::More
Tony Cook authored
50 ok($out->write(file=>'testout/t67_blue.ppm', type=>'pnm'),
51 "save blue image");
faa9b3e Egads
Tony Cook authored
52 }
53
54 # test against 16-bit/sample images
6175309 convert to Test::More
Tony Cook authored
55 {
6286932 reorganize convert.c to convert.im
Tony Cook authored
56 SKIP:
57 {
58 my $imbase16 = Imager::i_img_16_new(200, 200, 3);
59
60 my $im16targ = i_convert($imbase16, [ [ 0, 0, 0, 1 ],
61 [ 0, 0, 0, 0 ],
62 [ 0, 0, 0, 0 ] ]);
63 ok($im16targ, "convert 16/bit sample image")
64 or skip("could not convert 16-bit image", 2);
65
66 # image should still be 16-bit
67 is(Imager::i_img_bits($im16targ), 16, "Image still 16-bit/sample");
68
69 # make sure that it's roughly red
70 test_colorf_gpix($im16targ, 0, 0, NCF(1, 0, 0), 0.001, "image roughly red");
71 }
72 SKIP:
73 {
74 my $imbase16 = Imager->new(xsize => 10, ysize => 10, bits => 16);
75 ok($imbase16->setpixel
76 (x => 5, y => 2, color => Imager::Color::Float->new(0.1, 0.2, 0.3)),
77 "set a sample pixel");
78 my $c1 = $imbase16->getpixel(x => 5, y => 2, type => "float");
79 is_fcolor3($c1, 0.1, 0.2, 0.3, "check it was set")
80 or print "#", join(",", $c1->rgba), "\n";
81
82 my $targ16 = $imbase16->convert(matrix => [ [ 0.05, 0.15, 0.01, 0.5 ] ]);
83 ok($targ16, "convert another 16/bit sample image")
84 or skip("could not convert", 3);
85 is($targ16->getchannels, 1, "convert should be 1 channel");
86 is($targ16->bits, 16, "and 16-bits");
87 my $c = $targ16->getpixel(x => 5, y => 2, type => "float");
88 is_fcolor1($c, 0.538, 1/32768, "check grey value");
89 }
faa9b3e Egads
Tony Cook authored
90 }
91
92 # test against palette based images
93 my $impal = Imager::i_img_pal_new(200, 300, 3, 256);
94 my $black = NC(0, 0, 0);
6175309 convert to Test::More
Tony Cook authored
95 my $blackindex = Imager::i_addcolors($impal, $black);
96 ok($blackindex, "add black to paletted");
faa9b3e Egads
Tony Cook authored
97 for my $y (0..299) {
4cda4e7 added pixel type 'index' to getscanline() and setscanline() for
Tony Cook authored
98 Imager::i_ppal($impal, 0, $y, ($blackindex) x 200);
faa9b3e Egads
Tony Cook authored
99 }
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
100
6175309 convert to Test::More
Tony Cook authored
101 SKIP:
102 {
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
103 my $impalout = i_convert($impal, [ [ 0, 0, 0, 0 ],
104 [ 0, 0, 0, 1 ],
105 [ 0, 0, 0, 0 ] ]);
6175309 convert to Test::More
Tony Cook authored
106 skip("could not convert paletted", 3)
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
107 unless ok($impalout, "convert paletted");
6175309 convert to Test::More
Tony Cook authored
108 is(Imager::i_img_type($impalout), 1, "image still paletted");
109 is(Imager::i_colorcount($impalout), 1, "still only one colour");
110 my $c = Imager::i_getcolors($impalout, $blackindex);
111 ok($c, "get color from palette");
faa9b3e Egads
Tony Cook authored
112 my @ch = $c->rgba;
113 print "# @ch\n";
6175309 convert to Test::More
Tony Cook authored
114 ok($ch[0] == 0 && $ch[1] == 255 && $ch[2] == 0,
115 "colour is as expected");
f5991c0 implement the convert() method for converting between numbers of chan…
Tony Cook authored
116 }
6175309 convert to Test::More
Tony Cook authored
117
34b3f7e - the convert, crop, rotate, copy, matrix_transform, to_paletted, to_…
Tony Cook authored
118 { # http://rt.cpan.org/NoAuth/Bug.html?id=9672
6286932 reorganize convert.c to convert.im
Tony Cook authored
119 # methods that return a new image should warn in void context
34b3f7e - the convert, crop, rotate, copy, matrix_transform, to_paletted, to_…
Tony Cook authored
120 my $warning;
121 local $SIG{__WARN__} =
122 sub {
123 $warning = "@_";
124 my $printed = $warning;
125 $printed =~ s/\n$//;
126 $printed =~ s/\n/\n\#/g;
127 print "# ",$printed, "\n";
128 };
129 my $img = Imager->new(xsize=>10, ysize=>10);
130 $img->convert(preset=>"grey");
131 cmp_ok($warning, '=~', 'void', "correct warning");
132 cmp_ok($warning, '=~', 't67convert\\.t', "correct file");
133 }
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
134
135 { # http://rt.cpan.org/NoAuth/Bug.html?id=28492
6286932 reorganize convert.c to convert.im
Tony Cook authored
136 # convert() doesn't preserve image sample size
d5477d3 - Finished/rewrote Arnar's old SGI RGB file format support, so Imager
Tony Cook authored
137 my $im = Imager->new(xsize => 20, ysize => 20, channels => 3,
138 bits => 'double');
139 is($im->bits, 'double', 'check source bits');
140 my $conv = $im->convert(preset => 'grey');
141 is($conv->bits, 'double', 'make sure result has extra bits');
142 }
26eb06d @tonycoz [rt #79922] catch an invalid matrix supplied to convert()
authored
143
144 { # http://rt.cpan.org/NoAuth/Bug.html?id=79922
145 # Segfault in convert with bad params
146 my $im = Imager->new(xsize => 10, ysize => 10);
147 ok(!$im->convert(matrix => [ 10, 10, 10 ]),
148 "this would crash");
149 is($im->errstr, "convert: invalid matrix: element 0 is not an array ref",
150 "check the error message");
151 }
Something went wrong with that request. Please try again.