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

diff --git a/Changes b/Changes
index 8856148da773373af4483984d082ab0e75b7d3a0..9aeaf4fffb4fe880e3304ce9617f8808a98aac8d 100644 (file)
--- 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
 
    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
 ===========
 
 Imager 0.79 - 10 Dec 2010
 ===========
 

diff --git a/lib/Imager/Color/Float.pm b/lib/Imager/Color/Float.pm
index a042567821d3612088519104a3334083fbe9f8b2..def4192b0a827bfdb4365cf6cd6ca416035a08fc 100644 (file)
--- 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 (@_    ) 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) {
   }
   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 ();
 }
   }
   return ();
 }

diff --git a/t/t15color.t b/t/t15color.t
index c01859b34a01be6ff8f5f120ad6d4811f28d8c38..bed1a0174c5f0cacbfc4fc6464ba425b2e296457 100644 (file)
--- 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.)
 
 # 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);
 
 
 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 };
 }
   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) {
 sub test_col {
   my ($c, $r, $g, $b, $a) = @_;
   unless ($c) {