diff --git a/gsll.asd b/gsll.asd index 352ca80c96f5d39ec1115f229af450efcca90612..ac51e19615bd64036d1d3828f26fb1d60cbe3aef 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2008-08-31 22:50:22EDT gsll.asd> +;; Time-stamp: <2008-10-13 16:26:01EDT gsll.asd> ;; $Id$ (asdf:defsystem "gsll" @@ -24,7 +24,8 @@ (:file "callback" :depends-on (init)) ;; http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html (:file "lisp-unit") - (:file "tests" :depends-on (init lisp-unit)))) + (:file "tests" :depends-on (init lisp-unit)) + (:file "generate-tests" :depends-on (tests)))) (:module floating-point :depends-on (init) :components diff --git a/init/generate-tests.lisp b/init/generate-tests.lisp index 5bf4a0afd9f231c4fc3a09bcc930e1661e0f665b..ec4497d16b273baedb43656f5296e89d2721b227 100644 --- a/init/generate-tests.lisp +++ b/init/generate-tests.lisp @@ -1,6 +1,6 @@ ;; Make tests and examples ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp -;; Time-stamp: <2008-09-14 18:22:22EDT generate-tests.lisp> +;; Time-stamp: <2008-10-13 16:28:20EDT generate-tests.lisp> ;; $Id: $ (in-package :gsl) @@ -9,6 +9,61 @@ ;;;; Data pool ;;;;**************************************************************************** +;;; (make-test '(legendre-conicalP-half 3.5d0 10.0d0)) +(defun make-test (form) + "Make a test for lisp-unit." + (let ((vals (multiple-value-list (ignore-errors (eval form))))) + (if (typep (second vals) 'condition) + `(lisp-unit::assert-error + ',(type-of (second vals)) + ,form) + `(lisp-unit::assert-numerical-equal + ,(numerical-serialize vals) + (multiple-value-list ,form))))) + +(defmacro make-tests (name &rest forms) + (append + `(lisp-unit:define-test ,name) + (mapcar #'make-test forms))) + +(defparameter *all-generated-tests* nil) +(defmacro save-tests (name &rest forms) + "Save the each of the tests with the given name." + `(setf + (getf *all-generated-tests* ',name) + (remove-duplicates + (append + ',forms + (getf *all-generated-tests* ',name)) + :test #'equal))) + +(defun create-test (test-name) + "Find the saved test by name and create it, with the generated results." + (append + `(lisp-unit:define-test ,test-name) + (mapcar #'make-test (getf *all-generated-tests* test-name)))) + +(defun write-tests-to-file (filename) + "Write all the saved tests with expected results to the file." + (with-open-file (stream filename :direction :output :if-exists :supersede) + (format stream ";; Regression tests for GSLL, automatically generated~%~%") + (format stream "(in-package :gsl)~%~%") + (loop for (test-name forms) on *all-generated-tests* by #'cddr + do + (format t "Writing test ~a to file~&" test-name) + (format stream "~s~%~%" (create-test test-name))))) + +#| +(defmacro make-tests (name &rest forms) + (append + `(lisp-unit:define-test ,name) + (mapcar #'make-test forms))) +|# + +;;;;**************************************************************************** +;;;; Data pool +;;;;**************************************************************************** + ;; Signed ;;(loop repeat 100 collect (* (if (zerop (random 2)) -1 1) (random 128))) ;; Unsigned @@ -89,10 +144,10 @@ (if (member (first form) eval-list) (eval form) (mapcar (lambda (se) - (stupid-walk-form-eval-some se eval-list)) + (stupid-code-walk-eval-some se eval-list)) form)))) -(defun generate-all-array-tests (element-types test) +(defun generate-all-array-tests-body (element-types test) (iter (for default-element-type in (element-types element-types)) (declare (special default-element-type starting-element)) (setf starting-element 0) @@ -101,24 +156,20 @@ test '(vector-default scalar-default))))) +(defmacro generate-all-array-tests (name element-types test) + `(save-tests ,name ,@(generate-all-array-tests-body element-types test))) + #| -;;;;;;;;;; +(generate-all-array-tests + set-all-m+ :no-complex + (letm ((v1 (vector-default 3 t)) + (v2 (vector-default 3))) + (set-all v1 (scalar-default 2)) + (cl-array (m+ v1 v2)))) ;;; doesn't work for complex because: ;;; Cannot pass complex scalars to and from GSL functions (structs passed by value). -(generate-all-array-tests :no-complex - '(letm ((v1 (vector-default 3 t)) - (v2 (vector-default 3))) - (set-all v1 (scalar-default 2)) - (m+ v1 v2))) - - -;;; doesn't work for complex because GSL -(generate-all-array-tests :no-complex - '(letm ((v1 (vector-default 3)) - (v2 (vector-default 3))) - (m+ v1 v2))) |# diff --git a/init/init.lisp b/init/init.lisp index 6dea7675d33de6426b84ffe062aa9189b46cf2cf..86e1058a1499a8904b1d62b76712392599bf3da2 100644 --- a/init/init.lisp +++ b/init/init.lisp @@ -1,11 +1,11 @@ ;; Load GSL ;; Liam Healy Sat Mar 4 2006 - 18:53 -;; Time-stamp: <2008-04-06 22:17:32EDT init.lisp> +;; Time-stamp: <2008-10-11 14:26:33EDT init.lisp> ;; $Id$ (defpackage gsll (:nicknames :gsl) - (:use :common-lisp :cffi)) + (:use :common-lisp :cffi :iterate)) (cffi:define-foreign-library libgslcblas (:darwin (:or "/opt/local/lib/libgslcblas.dylib" "/usr/local/lib/libgslcblas.dylib")) diff --git a/init/tests.lisp b/init/tests.lisp index 9a263fd02eccaa4e105be1b50ffc9f7017b74024..bd30b50c38c746c4ee6b12245ea80344771393db 100644 --- a/init/tests.lisp +++ b/init/tests.lisp @@ -58,21 +58,3 @@ (lisp-unit::expand-assert :equal form form expected extras :test #'numerical-equal)) - - -;;; (make-test '(legendre-conicalP-half 3.5d0 10.0d0)) -(defun gsl::make-test (form) - "Make a test for lisp-unit." - (let ((vals (multiple-value-list (ignore-errors (eval form))))) - (if (typep (second vals) 'condition) - `(lisp-unit::assert-error - ',(type-of (second vals)) - ,form) - `(lisp-unit::assert-numerical-equal - ,(numerical-serialize vals) - (multiple-value-list ,form))))) - -(defmacro gsl::make-tests (name &rest forms) - (append - `(lisp-unit:define-test ,name) - (mapcar #'gsl::make-test forms))) diff --git a/special-functions/airy.lisp b/special-functions/airy.lisp index 9c757f670647af0fa5533337e78a0a137fbc1b2b..c7c240866e4e6e2ff9a03bb152a08807001002b4 100644 --- a/special-functions/airy.lisp +++ b/special-functions/airy.lisp @@ -1,6 +1,6 @@ ;; Airy functions ;; Liam Healy, Fri Mar 17 2006 - 18:41 -;; Time-stamp: <2008-08-10 17:50:02EDT airy.lisp> +;; Time-stamp: <2008-10-13 10:07:52EDT airy.lisp> ;; $Id$ (in-package :gsl) @@ -80,6 +80,20 @@ ;;;; Examples and unit test ;;;;**************************************************************************** +(save-tests airy + (airy-ai 2.5d0) + (airy-bi 2.5d0) + (airy-ai-scaled 2.5d0) + (airy-bi-scaled 2.5d0) + (airy-ai-deriv 2.5d0) + (airy-bi-deriv 2.5d0) + (airy-ai-deriv-scaled 2.5d0) + (airy-bi-deriv-scaled 2.5d0) + (airy-zero-ai 1) + (airy-zero-bi 1) + (airy-zero-ai-deriv 1) + (airy-zero-bi-deriv 1)) + #| (make-tests airy (airy-ai 2.5d0) @@ -146,3 +160,6 @@ Out[6]= -0.02625088103590323 In[7]:= AiryBiPrime[2.5] Out[7]= 9.4214233173343 |# + + + diff --git a/special-functions/clausen.lisp b/special-functions/clausen.lisp index be19eb1332a22d4b8b07508f9d6694e0c15204ed..ee1f46f633739768ac0ef4b4202127818d34bd6f 100644 --- a/special-functions/clausen.lisp +++ b/special-functions/clausen.lisp @@ -1,6 +1,6 @@ ;; Clausen function ;; Liam Healy, Sat Mar 18 2006 - 23:18 -;; Time-stamp: <2008-02-16 19:20:29EST clausen.lisp> +;; Time-stamp: <2008-10-13 10:04:52EDT clausen.lisp> ;; $Id$ (in-package :gsl) @@ -10,12 +10,4 @@ :documentation ; FDL "The Clausen integral Cl_2(x).") -#| -(make-tests clausen - (clausen 2.5d0)) -|# - -(LISP-UNIT:DEFINE-TEST CLAUSEN - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST 0.4335982032355329d0 1.2032502825912828d-15) - (MULTIPLE-VALUE-LIST (CLAUSEN 2.5d0)))) +(save-tests clausen (clausen 2.5d0))