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
;; 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: $
;;; Generate each file with #'write-test-to-file, e.g.
......@@ -62,7 +62,7 @@
(generate-all-array-tests vector-add :no-complex
(let ((v1 (array-default 3))
(v2 (array-default 3)))
(cl-array (elt+ v1 v2))))
(elt+ v1 v2)))
(generate-all-array-tests matrix-add :no-complex
(let ((m1 (array-default '(3 3)))
......
;; Definition of GSLL system
;; 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"
:name "gsll-tests"
......@@ -10,7 +10,10 @@
:licence "LLGPL v3, FDL"
:depends-on (gsll lisp-unit)
:components
((:module tests
((:module test-unit
:components
((:file "augment")))
(:module tests
:components
((:file "absolute-deviation")
(: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.
;; 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: $
;;; Througout the GSLL interface definition files are #'save-test
......@@ -26,7 +26,9 @@
(defun numerical-serialize (form)
(if (typep form 'list)
(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))
(defun make-test (form)
......
......@@ -3,8 +3,10 @@
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST VECTOR-ADD
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(-43.43 42.36 -2.8600001))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
'(-43.43 42.36 -2.8600001)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
......@@ -12,9 +14,12 @@
(V2
(MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
'(-8.93 34.12 -6.15))))
(CL-ARRAY (ELT+ V1 V2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(-43.43d0 42.36d0 -2.8600000000000003d0))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(-43.43d0 42.36d0
-2.8600000000000003d0)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
......@@ -22,151 +27,101 @@
(V2
(MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(-8.93d0 34.12d0 -6.15d0))))
(CL-ARRAY (ELT+ V1 V2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(101 -16 61))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
'(101 -16 61)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(SIGNED-BYTE
8)
:INITIAL-CONTENTS
'(-64 -68
71)))
(MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
'(-64 -68 71)))
(V2
(MAKE-MARRAY
'(SIGNED-BYTE
8)
:INITIAL-CONTENTS
'(-91 52
-10))))
(CL-ARRAY
(ELT+ V1 V2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 207 73))
(MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
'(-91 52 -10))))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS
'(183 207 73)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(UNSIGNED-BYTE
8)
:INITIAL-CONTENTS
'(67 44
189)))
(MAKE-MARRAY '(UNSIGNED-BYTE 8)
:INITIAL-CONTENTS '(67 44 189)))
(V2
(MAKE-MARRAY
'(UNSIGNED-BYTE
8)
:INITIAL-CONTENTS
'(116 163
140))))
(CL-ARRAY
(ELT+ V1 V2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-155 -16 61))
(MAKE-MARRAY '(UNSIGNED-BYTE 8)
:INITIAL-CONTENTS '(116 163 140))))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(SIGNED-BYTE 16) :INITIAL-CONTENTS
'(-155 -16 61)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(SIGNED-BYTE
16)
:INITIAL-CONTENTS
'(-64 -68
71)))
(MAKE-MARRAY '(SIGNED-BYTE 16)
:INITIAL-CONTENTS '(-64 -68 71)))
(V2
(MAKE-MARRAY
'(SIGNED-BYTE
16)
:INITIAL-CONTENTS
'(-91 52
-10))))
(CL-ARRAY
(ELT+ V1 V2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 207 329))
(MAKE-MARRAY '(SIGNED-BYTE 16)
:INITIAL-CONTENTS '(-91 52 -10))))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(UNSIGNED-BYTE 16) :INITIAL-CONTENTS
'(183 207 329)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(UNSIGNED-BYTE
16)
:INITIAL-CONTENTS
'(67 44
189)))
(MAKE-MARRAY '(UNSIGNED-BYTE 16)
:INITIAL-CONTENTS '(67 44 189)))
(V2
(MAKE-MARRAY
'(UNSIGNED-BYTE
16)
:INITIAL-CONTENTS
'(116 163
140))))
(CL-ARRAY
(ELT+ V1 V2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-155 -16 61))
(MAKE-MARRAY '(UNSIGNED-BYTE 16)
:INITIAL-CONTENTS '(116 163 140))))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(SIGNED-BYTE 32) :INITIAL-CONTENTS
'(-155 -16 61)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(SIGNED-BYTE
32)
:INITIAL-CONTENTS
'(-64 -68
71)))
(MAKE-MARRAY '(SIGNED-BYTE 32)
:INITIAL-CONTENTS '(-64 -68 71)))
(V2
(MAKE-MARRAY
'(SIGNED-BYTE
32)
:INITIAL-CONTENTS
'(-91 52
-10))))
(CL-ARRAY
(ELT+ V1 V2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 207 329))
(MAKE-MARRAY '(SIGNED-BYTE 32)
:INITIAL-CONTENTS '(-91 52 -10))))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(UNSIGNED-BYTE 32) :INITIAL-CONTENTS
'(183 207 329)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(UNSIGNED-BYTE
32)
:INITIAL-CONTENTS
'(67 44
189)))
(MAKE-MARRAY '(UNSIGNED-BYTE 32)
: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))
(MAKE-MARRAY '(UNSIGNED-BYTE 32)
:INITIAL-CONTENTS '(116 163 140))))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(SIGNED-BYTE 64) :INITIAL-CONTENTS
'(-155 -16 61)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(SIGNED-BYTE
64)
:INITIAL-CONTENTS
'(-64 -68
71)))
(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))
(MAKE-MARRAY '(SIGNED-BYTE 64)
:INITIAL-CONTENTS '(-91 52 -10))))
(ELT+ V1 V2))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(MAKE-MARRAY '(UNSIGNED-BYTE 64) :INITIAL-CONTENTS
'(183 207 329)))
(MULTIPLE-VALUE-LIST
(LET ((V1
(MAKE-MARRAY
'(UNSIGNED-BYTE
64)
:INITIAL-CONTENTS
'(67 44
189)))
(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))))))
(MAKE-MARRAY '(UNSIGNED-BYTE 64)
:INITIAL-CONTENTS '(116 163 140))))
(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