Commit 6bb17e91 authored by Liam Healy's avatar Liam Healy

Test generation (including arrays) with save-tests

New macro #'save-tests will put list of tests onto
*all-generated-tests*.  The corresponding lisp-unit test can be
generated with #'create-test.  The macro #'generate-all-array-tests
now uses #'save-tests, so all tests defined that way will be put onto
the lists.  All tests can be written to a file with
#'write-tests-to-file, but this writes to a single file and I think I
will want to write each test to a separate file so that it is easier
to replace or augment one test without touching the others.  Two
sections, Airy and Clausen, use these definitions.
parent 4e6d5886
;; 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
......
;; 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)))
|#
;; 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"))
......
......@@ -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)))
;; 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
|#
;; 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))
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