Commit 64a0b6c2 authored by Liam Healy's avatar Liam Healy
Browse files

Tests marrays directly

Thanks to Malcolm Reynolds and Tom Hermann, lisp-unit:numerical-equal
is now a generic function, so in the new file test-unit/augment.lisp,
a method has been defined to work on marrays.  This now permits the
direct comparison in tests of marrays, rather than looking at their CL
equivalent with cl-array.  So far the only test changed is
vector-add.
parent eb1420b4
;; Tests of array functions ;; Tests of array functions
;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp ;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp
;; Time-stamp: <2009-01-11 22:19:58EST array-tests.lisp> ;; Time-stamp: <2009-04-15 23:28:05EDT array-tests.lisp>
;; $Id: $ ;; $Id: $
;;; Generate each file with #'write-test-to-file, e.g. ;;; Generate each file with #'write-test-to-file, e.g.
...@@ -62,7 +62,7 @@ ...@@ -62,7 +62,7 @@
(generate-all-array-tests vector-add :no-complex (generate-all-array-tests vector-add :no-complex
(let ((v1 (array-default 3)) (let ((v1 (array-default 3))
(v2 (array-default 3))) (v2 (array-default 3)))
(cl-array (elt+ v1 v2)))) (elt+ v1 v2)))
(generate-all-array-tests matrix-add :no-complex (generate-all-array-tests matrix-add :no-complex
(let ((m1 (array-default '(3 3))) (let ((m1 (array-default '(3 3)))
......
;; Definition of GSLL system ;; Definition of GSLL system
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2009-03-16 19:02:05EDT gsll-tests.asd> ;; Time-stamp: <2009-04-15 23:26:17EDT gsll-tests.asd>
(asdf:defsystem "gsll-tests" (asdf:defsystem "gsll-tests"
:name "gsll-tests" :name "gsll-tests"
...@@ -10,7 +10,10 @@ ...@@ -10,7 +10,10 @@
:licence "LLGPL v3, FDL" :licence "LLGPL v3, FDL"
:depends-on (gsll lisp-unit) :depends-on (gsll lisp-unit)
:components :components
((:module tests ((:module test-unit
:components
((:file "augment")))
(:module tests
:components :components
((:file "absolute-deviation") ((:file "absolute-deviation")
(:file "absolute-sum") (:file "absolute-sum")
......
;; Additional methods for lisp-unit
;; Liam Healy 2009-04-15 23:23:30EDT augment.lisp
;; Time-stamp: <2009-04-15 23:24:22EDT augment.lisp>
;; $Id: $
(in-package :gsl)
(defmethod lisp-unit:numerical-equal
((result1 marray) (result2 marray) &key (test #'lisp-unit:number-equal))
"Return true if the arrays are numerically equal according to :TEST."
(when (equal (dimensions result1) (dimensions result2))
(lisp-unit:numerical-equal (cl-array result1) (cl-array result2))
:test test))
;; Make tests from examples. ;; Make tests from examples.
;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
;; Time-stamp: <2009-01-04 11:00:11EST generate-tests.lisp> ;; Time-stamp: <2009-04-15 23:33:26EDT generate-tests.lisp>
;; $Id: $ ;; $Id: $
;;; Througout the GSLL interface definition files are #'save-test ;;; Througout the GSLL interface definition files are #'save-test
...@@ -26,7 +26,9 @@ ...@@ -26,7 +26,9 @@
(defun numerical-serialize (form) (defun numerical-serialize (form)
(if (typep form 'list) (if (typep form 'list)
(cons 'list (mapcar #'numerical-serialize form)) (cons 'list (mapcar #'numerical-serialize form))
form)) (if (typep form 'mobject)
(make-load-form form)
form)))
;;; (make-test '(legendre-conicalP-half 3.5d0 10.0d0)) ;;; (make-test '(legendre-conicalP-half 3.5d0 10.0d0))
(defun make-test (form) (defun make-test (form)
......
...@@ -3,8 +3,10 @@ ...@@ -3,8 +3,10 @@
(in-package :gsl) (in-package :gsl)
(LISP-UNIT:DEFINE-TEST VECTOR-ADD (LISP-UNIT:DEFINE-TEST VECTOR-ADD
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #(-43.43 42.36 -2.8600001)) (LIST
(MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
'(-43.43 42.36 -2.8600001)))
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((V1 (LET ((V1
(MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
...@@ -12,9 +14,12 @@ ...@@ -12,9 +14,12 @@
(V2 (V2
(MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
'(-8.93 34.12 -6.15)))) '(-8.93 34.12 -6.15))))
(CL-ARRAY (ELT+ V1 V2))))) (ELT+ V1 V2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #(-43.43d0 42.36d0 -2.8600000000000003d0)) (LIST
(MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(-43.43d0 42.36d0
-2.8600000000000003d0)))
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((V1 (LET ((V1
(MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
...@@ -22,151 +27,101 @@ ...@@ -22,151 +27,101 @@
(V2 (V2
(MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(-8.93d0 34.12d0 -6.15d0)))) '(-8.93d0 34.12d0 -6.15d0))))
(CL-ARRAY (ELT+ V1 V2))))) (ELT+ V1 V2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(101 -16 61)) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(MULTIPLE-VALUE-LIST (LIST
(LET ((V1 (MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
(MAKE-MARRAY '(101 -16 61)))
'(SIGNED-BYTE (MULTIPLE-VALUE-LIST
8) (LET ((V1
:INITIAL-CONTENTS (MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
'(-64 -68 '(-64 -68 71)))
71))) (V2
(V2 (MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
(MAKE-MARRAY '(-91 52 -10))))
'(SIGNED-BYTE (ELT+ V1 V2))))
8) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
:INITIAL-CONTENTS (LIST
'(-91 52 (MAKE-MARRAY '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS
-10)))) '(183 207 73)))
(CL-ARRAY (MULTIPLE-VALUE-LIST
(ELT+ V1 V2))))) (LET ((V1
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 207 73)) (MAKE-MARRAY '(UNSIGNED-BYTE 8)
(MULTIPLE-VALUE-LIST :INITIAL-CONTENTS '(67 44 189)))
(LET ((V1 (V2
(MAKE-MARRAY (MAKE-MARRAY '(UNSIGNED-BYTE 8)
'(UNSIGNED-BYTE :INITIAL-CONTENTS '(116 163 140))))
8) (ELT+ V1 V2))))
:INITIAL-CONTENTS (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
'(67 44 (LIST
189))) (MAKE-MARRAY '(SIGNED-BYTE 16) :INITIAL-CONTENTS
(V2 '(-155 -16 61)))
(MAKE-MARRAY (MULTIPLE-VALUE-LIST
'(UNSIGNED-BYTE (LET ((V1
8) (MAKE-MARRAY '(SIGNED-BYTE 16)
:INITIAL-CONTENTS :INITIAL-CONTENTS '(-64 -68 71)))
'(116 163 (V2
140)))) (MAKE-MARRAY '(SIGNED-BYTE 16)
(CL-ARRAY :INITIAL-CONTENTS '(-91 52 -10))))
(ELT+ V1 V2))))) (ELT+ V1 V2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-155 -16 61)) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(MULTIPLE-VALUE-LIST (LIST
(LET ((V1 (MAKE-MARRAY '(UNSIGNED-BYTE 16) :INITIAL-CONTENTS
(MAKE-MARRAY '(183 207 329)))
'(SIGNED-BYTE (MULTIPLE-VALUE-LIST
16) (LET ((V1
:INITIAL-CONTENTS (MAKE-MARRAY '(UNSIGNED-BYTE 16)
'(-64 -68 :INITIAL-CONTENTS '(67 44 189)))
71))) (V2
(V2 (MAKE-MARRAY '(UNSIGNED-BYTE 16)
(MAKE-MARRAY :INITIAL-CONTENTS '(116 163 140))))
'(SIGNED-BYTE (ELT+ V1 V2))))
16) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
:INITIAL-CONTENTS (LIST
'(-91 52 (MAKE-MARRAY '(SIGNED-BYTE 32) :INITIAL-CONTENTS
-10)))) '(-155 -16 61)))
(CL-ARRAY (MULTIPLE-VALUE-LIST
(ELT+ V1 V2))))) (LET ((V1
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 207 329)) (MAKE-MARRAY '(SIGNED-BYTE 32)
(MULTIPLE-VALUE-LIST :INITIAL-CONTENTS '(-64 -68 71)))
(LET ((V1 (V2
(MAKE-MARRAY (MAKE-MARRAY '(SIGNED-BYTE 32)
'(UNSIGNED-BYTE :INITIAL-CONTENTS '(-91 52 -10))))
16) (ELT+ V1 V2))))
:INITIAL-CONTENTS (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
'(67 44 (LIST
189))) (MAKE-MARRAY '(UNSIGNED-BYTE 32) :INITIAL-CONTENTS
(V2 '(183 207 329)))
(MAKE-MARRAY (MULTIPLE-VALUE-LIST
'(UNSIGNED-BYTE (LET ((V1
16) (MAKE-MARRAY '(UNSIGNED-BYTE 32)
:INITIAL-CONTENTS :INITIAL-CONTENTS '(67 44 189)))
'(116 163 (V2
140)))) (MAKE-MARRAY '(UNSIGNED-BYTE 32)
(CL-ARRAY :INITIAL-CONTENTS '(116 163 140))))
(ELT+ V1 V2))))) (ELT+ V1 V2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-155 -16 61)) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(MULTIPLE-VALUE-LIST (LIST
(LET ((V1 (MAKE-MARRAY '(SIGNED-BYTE 64) :INITIAL-CONTENTS
(MAKE-MARRAY '(-155 -16 61)))
'(SIGNED-BYTE (MULTIPLE-VALUE-LIST
32) (LET ((V1
:INITIAL-CONTENTS (MAKE-MARRAY '(SIGNED-BYTE 64)
'(-64 -68 :INITIAL-CONTENTS '(-64 -68 71)))
71))) (V2
(V2 (MAKE-MARRAY '(SIGNED-BYTE 64)
(MAKE-MARRAY :INITIAL-CONTENTS '(-91 52 -10))))
'(SIGNED-BYTE (ELT+ V1 V2))))
32) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
:INITIAL-CONTENTS (LIST
'(-91 52 (MAKE-MARRAY '(UNSIGNED-BYTE 64) :INITIAL-CONTENTS
-10)))) '(183 207 329)))
(CL-ARRAY (MULTIPLE-VALUE-LIST
(ELT+ V1 V2))))) (LET ((V1
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 207 329)) (MAKE-MARRAY '(UNSIGNED-BYTE 64)
(MULTIPLE-VALUE-LIST :INITIAL-CONTENTS '(67 44 189)))
(LET ((V1 (V2
(MAKE-MARRAY (MAKE-MARRAY '(UNSIGNED-BYTE 64)
'(UNSIGNED-BYTE :INITIAL-CONTENTS '(116 163 140))))
32) (ELT+ V1 V2)))))
:INITIAL-CONTENTS
'(67 44
189)))
(V2
(MAKE-MARRAY
'(UNSIGNED-BYTE
32)
:INITIAL-CONTENTS
'(116 163
140))))
(CL-ARRAY
(ELT+ V1 V2)))))
#+int64
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-155 -16 61))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(SIGNED-BYTE
64)
:INITIAL-CONTENTS
'(-64 -68
71)))
(V2
(MAKE-MARRAY
'(SIGNED-BYTE
64)
:INITIAL-CONTENTS
'(-91 52
-10))))
(CL-ARRAY
(ELT+ V1 V2)))))
#+int64
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 207 329))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(UNSIGNED-BYTE
64)
:INITIAL-CONTENTS
'(67 44
189)))
(V2
(MAKE-MARRAY
'(UNSIGNED-BYTE
64)
:INITIAL-CONTENTS
'(116 163
140))))
(CL-ARRAY
(ELT+ V1 V2))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment