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