tests

* Also fix a couple of buglets revealed by the same.

* Get rid of SAFE-CHECK.

NOTES

@@ -10,14 +10,14 @@
 *** TODO Manual
 *** TODO VEC
 ***** DONE VEC type
-***** TODO Predicates
-******* TODO Tests
+***** DONE Predicates
+******* DONE Tests
 ******* DONE VECP
 ******* DONE POINTP
 ******* DONE VECTOR3P
 ******* DONE VEC=
-***** TODO Constructors & copiers
-******* TODO Tests
+***** DONE Constructors & copiers
+******* DONE Tests
 ******* DONE ALLOC-VEC
 ******* DONE VEC
 ******* DONE COPY-VEC, %COPY-VEC

package.lisp

@@ -28,6 +28,7 @@
    #:point->vector3
    #:pointp
    #:vec
+   #:vec=
    #:vecp
    #:vector3
    #:vector3->point

sb-cga.asd

@@ -22,5 +22,4 @@
   ((:file "package")
    (:file "types" :depends-on ("package"))
    (:file "vm" :depends-on ("package"))
-   (:file "utils" :depends-on ("package"))
-   (:file "vec" :depends-on ("package" "types" "utils" "vm"))))
+   (:file "vec" :depends-on ("package" "types" "vm"))))

tests.lisp

@@ -0,0 +1,117 @@
+;;;; By Nikodemus Siivola <nikodemus@random-state.net>, 2009.
+;;;;
+;;;; Permission is hereby granted, free of charge, to any person
+;;;; obtaining a copy of this software and associated documentation files
+;;;; (the "Software"), to deal in the Software without restriction,
+;;;; including without limitation the rights to use, copy, modify, merge,
+;;;; publish, distribute, sublicense, and/or sell copies of the Software,
+;;;; and to permit persons to whom the Software is furnished to do so,
+;;;; subject to the following conditions:
+;;;;
+;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+;;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+;;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+;;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+(require :sb-rt)
+
+(defpackage :sb-cga-test
+  (:use :cl :sb-rt :sb-cga))
+
+(in-package :sb-cga-test)
+
+;;; Cheap, cheap.
+(defmacro is ((test result (op &rest args)))
+  (let* ((temps (sb-int:make-gensym-list (length args)))
+         (form `(,op ,@args))
+         (lambda `(lambda ,temps (,op ,@temps))))
+    `(and (,test ,result (eval ',form))
+          (,test ,result (funcall (compile nil ',lambda) ,@args))
+          t)))
+
+(deftest alloc-vec.1
+    (is (vec= (vec 0.0 0.0 0.0 0.0)
+              (alloc-vec)))
+  t)
+
+(deftest vecp.1
+    (vecp (alloc-vector))
+  t)
+
+(deftest vecp.2
+    (vecp (make-array 3 :element-type 'single-float))
+  nil)
+
+(deftest vec=.1
+    (is (eq t (vec= (vec 1.0 1.0 1.0 1.0)
+                    (vec 1.0 1.0 1.0 1.0))))
+  t)
+
+(deftest vec=.2
+    (is (eq nil (vec= (vec -1.0 1.0 1.0 1.0)
+                      (vec 1.0 1.0 1.0 1.0))))
+  t)
+
+(deftest copy-vec.1
+    (let* ((orig (vec 1.0 2.0 3.0 4.0))
+           (copy (copy-vec orig)))
+      (and (not (eq orig copy))
+           (vec= orig copy)))
+  t)
+
+(deftest %copy-vec.2
+    (let* ((orig (vec 1.0 2.0 3.0 4.0))
+           (other (vec 0.1 0.2 0.3 0.4))
+           (copy (%copy-vec other orig)))
+      (and (eq other copy)
+           (not (eq orig copy))
+           (vec= copy orig)))
+  t)
+
+(deftest %copy-vec.3
+    (is (vec= (vec 1.0 0.1 3.0 4.0)
+              (%copy-vec (alloc-vec) (vec 1.0 0.1 3.0 4.0))))
+  t)
+
+(deftest point.1
+    (pointp (point 1.0 2.0 3.0))
+  t)
+
+(deftest point.2
+    (vector3p (point 1.0 2.0 3.0))
+  nil)
+
+(deftest vector3.1
+    (vector3p (vector3 1.0 2.0 3.0))
+  t)
+
+(deftest vector3.2
+    (pointp (vector3 1.0 2.0 3.0))
+  nil)
+
+(deftest point->vector3.1
+    (is (vec= (vector3 1.0 2.0 3.0)
+              (point->vector3 (point 1.0 2.0 3.0))))
+  t)
+
+(deftest point->vector3.1
+    (handler-case
+        (point->vector3 (vector3 1.0 2.0 3.0))
+      (type-error ()
+        :error))
+  :error)
+
+(deftest vector3->point.1
+    (is (vec= (point 1.0 2.0 3.0)
+              (vector3->point (vector3 1.0 2.0 3.0))))
+  t)
+
+(deftest vector3->point.1
+    (handler-case
+        (vector3->point (point 1.0 2.0 3.0))
+      (type-error ()
+        :error))
+  :error)

vec.lisp

@@ -46,7 +46,7 @@
 (deftype vector3 ()
   "3D vector type: subtype of VEC consisting of those VECs whose 4th element
 is 0.0."
-  `(satisfied vector3p))
+  `(satisfies vector3p))
 
 ;;;; CONSTRUCTORS
 
@@ -76,20 +76,18 @@ is 0.0."
 
 ;;;; CONVERSIONS
 
-(declaim (ftype (sfunction (vec) vec) point->vector3)
+(declaim (ftype (sfunction (point) vec) point->vector3)
          (inline point->vector3))
 (defun point->vector3 (point)
-  "Return 3D vector corresponding to coordinates of POINT. Outside safe code
-4th element of POINT is not asserted to be 1.0."
-  (safe-check (pointp point))
+  "Return 3D vector corresponding to coordinates of POINT. May signal a TYPE-ERROR
+if POINT is not a proper point with 4th element 1.0"
   (vector3 (aref point 0) (aref point 1) (aref point 2)))
 
-(declaim (ftype (sfunction (vec) vec) vector3->point)
+(declaim (ftype (sfunction (vector3) vec) vector3->point)
          (inline vector3->point))
 (defun vector3->point (location)
-  "Return point for corresponding to the 3D vector LOCATION. Outside safe code
-4th element of LOCATION is not asserted to be 0.0."
-  (safe-check (vector3p location))
+  "Return point for corresponding to the 3D vector LOCATION. May signal a TYPE-ERROR
+if LOCATION is not a proper 3D vector with 4th element 0.0"
   (point (aref location 0) (aref location 1) (aref location 2)))
 
 ;;;; COMPARISON