| 1 | #!/usr/bin/perl |
| 2 | use 5.008009; |
| 3 | use strict; |
| 4 | use warnings; |
| 5 | |
| 6 | use Convert::Color::RGB8; |
| 7 | use JSON::PP qw/decode_json/; |
| 8 | use Test::More tests => 5 * 4096; |
| 9 | |
| 10 | use constant EPSILON => $ENV{RELEASE_TESTING} ? 1e-11 : 2e-4; |
| 11 | my @spaces = qw/XYZ LUV LCh HUSL HUSLp/; |
| 12 | |
| 13 | sub isf { |
| 14 | my ($x, $y, $name) = @_; |
| 15 | ok !grep({ abs ($_ - shift @$y) > EPSILON } @$x), $name; |
| 16 | } |
| 17 | |
| 18 | if ($ENV{RELEASE_TESTING}) { |
| 19 | require JSON::MaybeXS; |
| 20 | open my $fh, '<', 't/snapshot-rev4.json'; |
| 21 | my $snapshot = join '', <$fh>; |
| 22 | |
| 23 | my %tests = %{JSON::MaybeXS::decode_json $snapshot}; |
| 24 | |
| 25 | for my $color (sort keys %tests) { |
| 26 | my $col = Convert::Color::RGB8->new(substr $color, 1); |
| 27 | isf $col->convert_to(lc), $tests{$color}{lc()}, "convert $color to $_" for @spaces; |
| 28 | } |
| 29 | } else { |
| 30 | open my $fh, '<', 't/snapshot-rev4.csv'; |
| 31 | <$fh>; |
| 32 | |
| 33 | while (<$fh>) { |
| 34 | my ($color, @good) = split ','; |
| 35 | my $col = Convert::Color::RGB8->new($color); |
| 36 | isf $col->convert_to(lc), \@good, "convert $color to $_" for @spaces |
| 37 | } |
| 38 | } |