]>
Commit | Line | Data |
---|---|---|
1f72b051 | 1 | #!/usr/bin/perl |
4e59696a MG |
2 | use 5.008009; |
3 | use strict; | |
1f72b051 MG |
4 | use warnings; |
5 | ||
6 | use Convert::Color::RGB8; | |
5fe56216 | 7 | use Test::More tests => 7 * ($ENV{RELEASE_TESTING} ? 4096 : 512); |
1f72b051 | 8 | |
3d128ec5 MG |
9 | use constant EPSILON => $ENV{RELEASE_TESTING} ? 1e-11 : 2e-4; |
10 | my @spaces = qw/XYZ LUV LCh HUSL HUSLp/; | |
1f72b051 MG |
11 | |
12 | sub isf { | |
5fe56216 MG |
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; | |
1f72b051 MG |
19 | } |
20 | ||
5fe56216 MG |
21 | my @tests; |
22 | ||
3d128ec5 MG |
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}; | |
5fe56216 | 29 | @tests = map { [$_, $tests{$_}] } sort keys %tests; |
3d128ec5 MG |
30 | } else { |
31 | open my $fh, '<', 't/snapshot-rev4.csv'; | |
32 | <$fh>; | |
33 | ||
34 | while (<$fh>) { | |
35 | my ($color, @good) = split ','; | |
5fe56216 MG |
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] | |
3d128ec5 | 40 | } |
1f72b051 | 41 | } |
5fe56216 MG |
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/HUSL HUSLp/; | |
48 | } |