From: Tony Cook <tony@develop-help.com>
Date: Mon, 10 Jan 2011 11:16:22 +0000 (+1100)
Subject: improve coverage testing Imager::Color::Float and fix a bug
X-Git-Tag: Imager-0.80~4
X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/34c03f04e0e814b5be98f0cd8ba456953dcfce4d?ds=inline

improve coverage testing Imager::Color::Float and fix a bug
---

diff --git a/Changes b/Changes
index 8856148d..9aeaf4ff 100644
--- a/Changes
+++ b/Changes
@@ -9,6 +9,9 @@ Bug fixes:
    by the default (qtype=normal) scaling method.
    https://rt.cpan.org/Public/Bug/Display.html?id=63922
 
+ - Imager::Color::Float now translates "#FFFFFF" to white instead of
+   just a little darker.
+
 Imager 0.79 - 10 Dec 2010
 ===========
 
diff --git a/lib/Imager/Color/Float.pm b/lib/Imager/Color/Float.pm
index a0425678..def4192b 100644
--- a/lib/Imager/Color/Float.pm
+++ b/lib/Imager/Color/Float.pm
@@ -16,10 +16,10 @@ sub _pspec {
   return (@_    ) if @_ == 4;
   if ($_[0] =~ 
       /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) {
-    return (hex($1)/255.99,hex($2)/255.99,hex($3)/255.99,hex($4)/255.99);
+    return (hex($1)/255,hex($2)/255,hex($3)/255,hex($4)/255);
   }
   if ($_[0] =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) {
-    return (hex($1)/255.99,hex($2)/255.99,hex($3)/255.99,1);
+    return (hex($1)/255,hex($2)/255,hex($3)/255,1);
   }
   return ();
 }
diff --git a/t/t15color.t b/t/t15color.t
index c01859b3..bed1a017 100644
--- a/t/t15color.t
+++ b/t/t15color.t
@@ -7,9 +7,10 @@
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
-use Test::More tests => 47;
+use Test::More tests => 55;
 
-BEGIN { use_ok('Imager'); };
+use Imager;
+use Imager::Test qw(is_fcolor4);
 
 init_log("testout/t15color.log",1);
 
@@ -126,7 +127,35 @@ color_ok('builtin black', 0, 0, 0, 255,
   is(@warnings, 0, "Should be no warnings")
     or do { print "# $_" for @warnings };
 }
- 
+
+{
+  # float color from hex triple
+  my $f3white = Imager::Color::Float->new("#FFFFFF");
+  is_fcolor4($f3white, 1.0, 1.0, 1.0, 1.0, "check color #FFFFFF");
+  my $f3black = Imager::Color::Float->new("#000000");
+  is_fcolor4($f3black, 0, 0, 0, 1.0, "check color #000000");
+  my $f3grey = Imager::Color::Float->new("#808080");
+  is_fcolor4($f3grey, 0x80/0xff, 0x80/0xff, 0x80/0xff, 1.0, "check color #808080");
+
+  my $f4white = Imager::Color::Float->new("#FFFFFF80");
+  is_fcolor4($f4white, 1.0, 1.0, 1.0, 0x80/0xff, "check color #FFFFFF80");
+}
+
+{
+  # fail to make a color
+  ok(!Imager::Color::Float->new("-unknown-"), "try to make float color -unknown-");
+}
+
+{
+  # set after creation
+  my $c = Imager::Color::Float->new(0, 0, 0);
+  is_fcolor4($c, 0, 0, 0, 1.0, "check simple init of float color");
+  ok($c->set(1.0, 0.5, 0.25, 1.0), "set() the color");
+  is_fcolor4($c, 1.0, 0.5, 0.25, 1.0, "check after set");
+
+  ok(!$c->set("-unknown-"), "set to unknown");
+}
+
 sub test_col {
   my ($c, $r, $g, $b, $a) = @_;
   unless ($c) {