]>
Commit | Line | Data |
---|---|---|
1 | #!/usr/bin/perl | |
2 | use 5.008009; | |
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use Convert::Color::RGB8; | |
7 | use Test::More tests => 7 * ($ENV{RELEASE_TESTING} ? 4096 : 512); | |
8 | ||
9 | use constant EPSILON => $ENV{RELEASE_TESTING} ? 1e-8 : 2e-4; | |
10 | my @spaces = qw/XYZ LUV LCh HSLuv HPLuv/; | |
11 | ||
12 | sub isf { | |
13 | my ($xx, $yy, $name) = @_; | |
14 | for (0 .. 2) { | |
15 | my ($x, $y) = ($xx->[$_], $yy->[$_]); | |
16 | do { diag "$x != $y"; return fail $name } if abs ($x - $y) > EPSILON; | |
17 | } | |
18 | pass $name; | |
19 | } | |
20 | ||
21 | my @tests; | |
22 | ||
23 | if ($ENV{RELEASE_TESTING}) { | |
24 | require JSON::MaybeXS; | |
25 | open my $fh, '<', 't/snapshot-rev4.json'; | |
26 | my $snapshot = join '', <$fh>; | |
27 | ||
28 | my %tests = %{JSON::MaybeXS::decode_json $snapshot}; | |
29 | @tests = map { [$_, $tests{$_}] } sort keys %tests; | |
30 | } else { | |
31 | open my $fh, '<', 't/snapshot-rev4.csv'; | |
32 | <$fh>; | |
33 | ||
34 | while (<$fh>) { | |
35 | my ($color, @good) = split ','; | |
36 | my %test; | |
37 | $test{rgb} = [Convert::Color::RGB8->new($color)->rgb]; | |
38 | $test{lc $spaces[$_]} = [@good[$_ * 3 .. $_ * 3 + 2]] for 0 .. $#spaces; | |
39 | push @tests, ["#$color", \%test] | |
40 | } | |
41 | } | |
42 | ||
43 | for my $test (@tests) { | |
44 | my ($color, $data) = @$test; | |
45 | my $col = Convert::Color::RGB8->new(substr $color, 1); | |
46 | isf $col->convert_to(lc), $data->{lc()}, "convert $color to $_" for @spaces; | |
47 | isf [$col->convert_to(lc)->rgb], $data->{rgb}, "convert $color to $_ and back" for qw/HSLuv HPLuv/; | |
48 | } |