X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=t%2FConvert-Color-HUSL.t;h=3474d3cdcdca8e0f93b257f5ec1e0714ee0de0ce;hb=5fe5621619cabcccaccc1b2de34654f32d1dc475;hp=3173ee828189bd347e0e79aabf94b49b057c7c3d;hpb=1f72b051c754be821a14b94b1828d71e40631de3;p=convert-color-husl.git diff --git a/t/Convert-Color-HUSL.t b/t/Convert-Color-HUSL.t index 3173ee8..3474d3c 100644 --- a/t/Convert-Color-HUSL.t +++ b/t/Convert-Color-HUSL.t @@ -1,38 +1,48 @@ #!/usr/bin/perl -use 5.014000; +use 5.008009; +use strict; use warnings; use Convert::Color::RGB8; -use JSON::PP qw/decode_json/; -use Test::More; +use Test::More tests => 7 * ($ENV{RELEASE_TESTING} ? 4096 : 512); -use constant EPSILON => 1e-4; # 1e-11 is OK on amd64 +use constant EPSILON => $ENV{RELEASE_TESTING} ? 1e-11 : 2e-4; +my @spaces = qw/XYZ LUV LCh HUSL HUSLp/; -open my $fh, '<', 't/snapshot-rev3.json'; -my $snapshot = join '', <$fh>; -close $fh; +sub isf { + my ($xx, $yy, $name) = @_; + for (0 .. 2) { + my ($x, $y) = ($xx->[$_], $yy->[$_]); + do { diag "$x != $y"; return fail $name } if abs ($x - $y) > EPSILON; + } + pass $name; +} -my %tests = %{decode_json $snapshot}; -my @colors = sort keys %tests; +my @tests; -plan tests => 5 * @colors; +if ($ENV{RELEASE_TESTING}) { + require JSON::MaybeXS; + open my $fh, '<', 't/snapshot-rev4.json'; + my $snapshot = join '', <$fh>; -sub isf { - my ($x, $y, $name) = @_; - my $ok = 1; - $ok &&= abs ($x->[$_] - $y->[$_]) < EPSILON for 0, 1, 2; - return pass $name if $ok; - local $" = ', '; - fail $name; - diag "[@$x] != [@$y]"; + my %tests = %{JSON::MaybeXS::decode_json $snapshot}; + @tests = map { [$_, $tests{$_}] } sort keys %tests; +} else { + open my $fh, '<', 't/snapshot-rev4.csv'; + <$fh>; + + while (<$fh>) { + my ($color, @good) = split ','; + my %test; + $test{rgb} = [Convert::Color::RGB8->new($color)->rgb]; + $test{lc $spaces[$_]} = [@good[$_ * 3 .. $_ * 3 + 2]] for 0 .. $#spaces; + push @tests, ["#$color", \%test] + } } -for my $color (@colors) { - my %color = %{$tests{$color}}; +for my $test (@tests) { + my ($color, $data) = @$test; my $col = Convert::Color::RGB8->new(substr $color, 1); - isf $col->convert_to('xyz'), $color{xyz}, "convert $color to XYZ"; - isf $col->convert_to('luv'), $color{luv}, "convert $color to LUV"; - isf $col->convert_to('lch'), $color{lch}, "convert $color to LCh"; - isf $col->convert_to('husl'), $color{husl}, "convert $color to HUSL"; - isf $col->convert_to('huslp'), $color{huslp}, "convert $color to HUSLp"; + isf $col->convert_to(lc), $data->{lc()}, "convert $color to $_" for @spaces; + isf [$col->convert_to(lc)->rgb], $data->{rgb}, "convert $color to $_ and back" for qw/HUSL HUSLp/; }