test.lisp 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081
  1. (in-package #:cl-user)
  2. (defpackage #:cl-colors2-tests
  3. (:use
  4. #:alexandria
  5. #:common-lisp
  6. #:cl-colors2
  7. #:clunit)
  8. (:export #:run))
  9. (in-package #:cl-colors2-tests)
  10. (defsuite cl-colors-suite ())
  11. (defun run (&key (use-debugger nil))
  12. "Run all the tests for CL-COLORS2-TESTS."
  13. (clunit:run-suite 'cl-colors-suite :use-debugger use-debugger))
  14. (defun rgb= (rgb1 rgb2 &optional (epsilon 1e-10))
  15. "Compare RGB colors for (numerical) equality."
  16. (color-equals rgb1 rgb2 :tolerance epsilon))
  17. (defun random-rgb ()
  18. (rgb (random 1d0) (random 1d0) (random 1d0)))
  19. (deftest rgb<->hsv-test (cl-colors-suite)
  20. (loop repeat 100 do
  21. (let ((rgb (random-rgb)))
  22. (assert-true (rgb= rgb (as-rgb (as-hsv rgb))))
  23. (assert-true (color-equals (as-hsv rgb) rgb)))))
  24. (deftest parse-name (cl-colors-suite)
  25. (assert-true (as-rgb "snow")))
  26. ;; (defun test-hue-combination (from to positivep)
  27. ;; (dotimes (i 21)
  28. ;; (format t "~a " (hue-combination from to (/ i 20) positivep))))
  29. (deftest print-hex-rgb-test (cl-colors-suite)
  30. (let ((rgb (rgb 0.070 0.203 0.337)))
  31. (assert-equalp "#123456" (print-hex-rgb rgb))
  32. (assert-equalp "123456" (print-hex-rgb rgb :hash nil))
  33. (assert-equalp "#135" (print-hex-rgb rgb :short t))
  34. (assert-equalp "135" (print-hex-rgb rgb :hash nil :short t))
  35. (assert-equalp "#12345678" (print-hex-rgb rgb :alpha 0.47))
  36. (assert-equalp "12345678" (print-hex-rgb rgb :alpha 0.47 :hash nil))
  37. (assert-equalp "#1357" (print-hex-rgb rgb :alpha 0.47 :short t))
  38. (assert-equalp "1357" (print-hex-rgb rgb :alpha 0.47 :hash nil :short t))))
  39. (deftest parse-hex-rgb-test (cl-colors-suite)
  40. (let ((rgb (rgb 0.070 0.203 0.337))
  41. (*clunit-equality-test* (rcurry #'rgb= 0.01)))
  42. (assert-equality* rgb (parse-hex-rgb "#123456"))
  43. (assert-equality* rgb (parse-hex-rgb "123456"))
  44. (assert-equality* rgb (parse-hex-rgb "#135"))
  45. (assert-equality* rgb (parse-hex-rgb "135"))
  46. (let ((*clunit-equality-test* #'(lambda (list1 list2)
  47. (and (rgb= (car list1) (car list2) 0.01)
  48. (cl-colors2::eps= (cadr list1) (cadr list2)
  49. 0.01)))))
  50. (assert-equality* (list rgb 0.47) (multiple-value-list (parse-hex-rgb "#12345678")))
  51. (assert-equality* (list rgb 0.47) (multiple-value-list (parse-hex-rgb "12345678")))
  52. (assert-equality* (list rgb 0.47) (multiple-value-list (parse-hex-rgb "#1357")))
  53. (assert-equality* (list rgb 0.47) (multiple-value-list (parse-hex-rgb "1357"))))))
  54. (deftest print-hex-rgb/format-test (cl-colors-suite)
  55. (assert-equalp "#123456" (with-output-to-string (*standard-output*)
  56. (print-hex-rgb (rgb 0.070 0.203 0.337)
  57. :destination T))))
  58. (deftest hex<->rgb-test (cl-colors-suite)
  59. (loop repeat 100 do
  60. (let ((rgb (random-rgb))
  61. (*clunit-equality-test* (rcurry #'rgb= 0.01)))
  62. (assert-equality* rgb (parse-hex-rgb (print-hex-rgb rgb))))))
  63. (deftest parse-hex-rgb-ranges-test (cl-colors-suite)
  64. (let ((*clunit-equality-test* (rcurry #'rgb= 0.001)))
  65. (assert-equality* (rgb 0.070 0.203 0.337)
  66. (parse-hex-rgb "foo#123456zzz" :start 3 :end 10))))