r8057: add tests for color conversion, hsv-equal

[kmrcl.git] / tests.lisp

diff --git a/tests.lisp b/tests.lisp
index fc950e47ddf2a17d3b1ef979d29061332de9ad8f..bf088b44a2115b29114d57d726c590574918e389 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -186,6 +186,27 @@
 (deftest sse.4 (string-strip-ending "abc" '("ab")) "abc")
 (deftest sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
 
+
+(defun test-color-conversion ()
+  (dotimes (ih 11)
+    (dotimes (is 11)
+      (dotimes (iv 11)
+        (let ((h (/ ih 10))
+              (s (/ is 10))
+              (v (/ iv 10)))
+          (multiple-value-bind (r g b) (hsv->rgb h s v)
+            (multiple-value-bind (h2 s2 v2) (rgb->hsv r g b)
+              (unless (hsv-equal h s v h2 s2 v2)
+                (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%" 
+                        (float r) (float g) (float b)
+                        (when (typep h 'number) (float h))
+                        (when (typep h2 'number) (float h2))
+                        (float s) (float s2) (float v) (float v2))
+                (return-from test-color-conversion nil))))))))
+  t)
+
+(deftest color (test-color-conversion) t)
+
   
 ;;; MOP Testing