Permalink
Browse files

Integrated the tests (actually, a single one) into a formal framework.

  • Loading branch information...
1 parent a461246 commit 5973ebe3bebf338f08154595dc4acec6e0f40438 @tpapp committed Jun 28, 2012
Showing with 40 additions and 26 deletions.
  1. +10 −2 cl-colors.asd
  2. +30 −24 test.lisp
View
12 cl-colors.asd
@@ -1,10 +1,18 @@
(defsystem #:cl-colors
:description "Simple color library for Common Lisp"
:version "0.2"
- :author "Tamas K Papp"
+ :author "Tamas K Papp <tkpapp@gmail.com>"
:license "Boost Software License - Version 1.0"
:serial t
:components ((:file "package")
(:file "colors")
(:file "colornames"))
- :depends-on (:alexandria :let-plus))
+ :depends-on (#:alexandria #:let-plus))
+
+(defsystem #:cl-colors-tests
+ :description "Unit tests for CL-COLORS."
+ :author "Tamas K Papp <tkpapp@gmail.com>"
+ :license "Boost Software License - Version 1.0"
+ :serial t
+ :components ((:file "test"))
+ :depends-on (#:cl-colors #:lift))
View
54 test.lisp
@@ -1,27 +1,33 @@
-(in-package :cl-colors)
+(in-package #:cl-user)
+
+(defpackage #:cl-colors-tests
+ (:use #:alexandria #:common-lisp #:cl-colors #:let-plus #:lift)
+ (:export #:run))
+
+(in-package #:cl-colors-tests)
+
+(deftestsuite cl-colors-tests () ())
+
+(defun run ()
+ "Run all the tests for CL-COLORS-TESTS."
+ (run-tests :suite 'cl-colors-tests))
(defun rgb= (rgb1 rgb2 &optional (epsilon 1e-10))
- (flet ((eps= (a b)
- (<= (abs (- a b)) epsilon)))
- (with-slots ((red1 red) (green1 green) (blue1 blue)) rgb1
- (with-slots ((red2 red) (green2 green) (blue2 blue)) rgb2
- (and (eps= red1 red2) (eps= green1 green2) (eps= blue1 blue2))))))
-
-(defun test-hsv-rgb ()
- (let* ((rgb (make-instance 'rgb
- :red (random 1d0)
- :green (random 1d0)
- :blue (random 1d0)))
- (hsv (rgb->hsv rgb))
- (rgb2 (hsv->rgb hsv))
- (result (rgb= rgb rgb2)))
- (unless result
- (format t "~a does not equal ~a~%" rgb rgb2))
- result))
-
-(dotimes (i 1000) (test-hsv-rgb))
-
-(defun test-hue-combination (from to positivep)
- (dotimes (i 21)
- (format t "~a " (hue-combination from to (/ i 20) positivep))))
+ "Compare RGB colors for (numerical) equality."
+ (let+ (((&flet eps= (a b) (<= (abs (- a b)) epsilon)))
+ ((&rgb red1 green1 blue1) rgb1)
+ ((&rgb red2 green2 blue2) rgb2))
+ (and (eps= red1 red2) (eps= green1 green2) (eps= blue1 blue2))))
+
+(defun random-rgb ()
+ (rgb (random 1d0) (random 1d0) (random 1d0)))
+
+(addtest (cl-colors-tests)
+ rgb<->hsv
+ (loop repeat 100 do
+ (let ((rgb (random-rgb)))
+ (ensure-same rgb (as-rgb (as-hsv rgb)) :test #'rgb=))))
+;; (defun test-hue-combination (from to positivep)
+;; (dotimes (i 21)
+;; (format t "~a " (hue-combination from to (/ i 20) positivep))))

0 comments on commit 5973ebe

Please sign in to comment.