[RT #67912] writing GIFs now always uses the generated (or supplied) colors
[imager.git] / GIF / t / t30fixed.t
1 #!perl -w
2 use strict;
3 use Test::More tests => 9;
4 use Imager;
5 use Imager::Test qw(test_image);
6
7 -d "testout" or mkdir "testout";
8
9 Imager->open_log(log => "testout/t30fixed.log");
10
11 {
12   # RT 67912
13   # previously, if you tried to write a paletted image to GIF:
14   #  - specified a fixed palette with make_colors => "mono", "web" or "none"
15   #  - there was room for the colors in the image in the rest of the
16   #  palette (or they were found in the generated palette)
17   # the GIF would be written with essentially it's original palette
18   # instead of the specified palette
19   #
20   # This was confusing, especially if you specified a restricted
21   # palette such as mono or a small greyscale ramp
22
23   my $src = test_image();
24   ok($src, "make source image");
25   my $pal = $src->to_paletted(max_colors => 250);
26   ok($pal, "make paletted version");
27   cmp_ok($pal->colorcount, "<=", 250, "make sure not too many colors");
28
29   my $mono = $src->to_paletted(make_colors => "mono", translate => "errdiff");
30   ok($mono, "make mono image directly");
31   ok($mono->write(file => "testout/t30monodirect.gif", type => "gif"),
32      "save mono direct image");
33
34   Imager->log("Save manually paletted version\n");
35   ok($pal->write(file => "testout/t30color.gif"),
36      "save generated palette version");
37   Imager->log("Save mono version\n");
38   ok($pal->write(file => "testout/t30monoind.gif", type => "gif",
39                  make_colors => "mono", translate => "errdiff"),
40      "write paletted with mono colormap");
41
42   my $rd = Imager->new(file => "testout/t30monoind.gif", type => "gif");
43   ok($rd, "read it back in");
44   is($rd->colorcount, 2, "should only have 2 colors");
45 }
46
47 Imager->close_log;