convert t/t020masked.t to Test::More

[imager.git] / t / t023palette.t

diff --git a/t/t023palette.t b/t/t023palette.t
index b002de94d13f001f99a4250d6d33ba8e19d619e1..3e3f3336279de7e4e716fb1ac06b83f0977194d0 100644 (file)
--- a/t/t023palette.t
+++ b/t/t023palette.t
@@ -1,9 +1,11 @@
 #!perl -w
 # some of this is tested in t01introvert.t too
 use strict;
-use Test::More tests => 90;
+use Test::More tests => 126;
 BEGIN { use_ok("Imager"); }
 
+use Imager::Test qw(image_bounds_checks test_image is_color3);
+
 sub isbin($$$);
 
 my $img = Imager->new(xsize=>50, ysize=>50, type=>'paletted');
@@ -278,6 +280,9 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/,
                                   translate => 'closest');
   is($mono->type, 'paletted', "check we get right image type");
   is($mono->colorcount, 2, "only 2 colors");
+  my ($is_mono, $ziw) = $mono->is_bilevel;
+  ok($is_mono, "check monochrome check true");
+  is($ziw, 0, "check ziw false");
   my @colors = $mono->getcolors;
   iscolor($colors[0], $black, "check first entry");
   iscolor($colors[1], $white, "check second entry");
@@ -287,6 +292,57 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/,
   is($pixels[2], 0, "check black pixel");
 }
 
+{ # check for the various mono images we accept
+  my $mono_8_bw_3 = Imager->new(xsize => 2, ysize => 2, channels => 3, 
+                             type => 'paletted');
+  ok($mono_8_bw_3->addcolors(colors => [ qw/000000 FFFFFF/ ]), 
+     "mono8bw3 - add colors");
+  ok($mono_8_bw_3->is_bilevel, "it's mono");
+  is(($mono_8_bw_3->is_bilevel)[1], 0, 'zero not white');
+  
+  my $mono_8_wb_3 = Imager->new(xsize => 2, ysize => 2, channels => 3, 
+                             type => 'paletted');
+  ok($mono_8_wb_3->addcolors(colors => [ qw/FFFFFF 000000/ ]), 
+     "mono8wb3 - add colors");
+  ok($mono_8_wb_3->is_bilevel, "it's mono");
+  is(($mono_8_wb_3->is_bilevel)[1], 1, 'zero is white');
+  
+  my $mono_8_bw_1 = Imager->new(xsize => 2, ysize => 2, channels => 1, 
+                             type => 'paletted');
+  ok($mono_8_bw_1->addcolors(colors => [ qw/000000 FFFFFF/ ]), 
+     "mono8bw - add colors");
+  ok($mono_8_bw_1->is_bilevel, "it's mono");
+  is(($mono_8_bw_1->is_bilevel)[1], 0, 'zero not white');
+  
+  my $mono_8_wb_1 = Imager->new(xsize => 2, ysize => 2, channels => 1, 
+                             type => 'paletted');
+  ok($mono_8_wb_1->addcolors(colors => [ qw/FFFFFF 000000/ ]), 
+     "mono8wb - add colors");
+  ok($mono_8_wb_1->is_bilevel, "it's mono");
+  is(($mono_8_wb_1->is_bilevel)[1], 1, 'zero is white');
+}
+
+{ # check bounds checking
+  my $im = Imager->new(xsize => 10, ysize => 10, type=>'paletted');
+  ok($im->addcolors(colors => [ $black ]), "add color of pixel bounds check writes");
+
+  image_bounds_checks($im);
+}
+
+{ # test colors array returns colors
+  my $data;
+  my $im = test_image();
+  my @colors;
+  my $imp = $im->to_paletted(colors => \@colors, 
+                            make_colors => 'webmap', 
+                            translate => 'closest');
+  ok($imp, "made paletted");
+  is(@colors, 216, "should be 216 colors in the webmap");
+  is_color3($colors[0], 0, 0, 0, "first should be 000000");
+  is_color3($colors[1], 0, 0, 0x33, "second should be 000033");
+  is_color3($colors[8], 0, 0x33, 0x66, "9th should be 003366");
+}
+
 sub iscolor {
   my ($c1, $c2, $msg) = @_;