Skip to content
Snippets Groups Projects
Commit 6bb17e91 authored by Liam Healy's avatar Liam Healy
Browse files

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
No related branches found
No related tags found
No related merge requests found
;; Definition of GSLL system ;; Definition of GSLL system
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2008-08-31 22:50:22EDT gsll.asd> ;; Time-stamp: <2008-10-13 16:26:01EDT gsll.asd>
;; $Id$ ;; $Id$
(asdf:defsystem "gsll" (asdf:defsystem "gsll"
...@@ -24,7 +24,8 @@ ...@@ -24,7 +24,8 @@
(:file "callback" :depends-on (init)) (:file "callback" :depends-on (init))
;; http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html ;; http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html
(:file "lisp-unit") (: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 (:module floating-point
:depends-on (init) :depends-on (init)
:components :components
......
;; Make tests and examples ;; Make tests and 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: <2008-09-14 18:22:22EDT generate-tests.lisp> ;; Time-stamp: <2008-10-13 16:28:20EDT generate-tests.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :gsl)
...@@ -9,6 +9,61 @@ ...@@ -9,6 +9,61 @@
;;;; Data pool ;;;; 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 ;; Signed
;;(loop repeat 100 collect (* (if (zerop (random 2)) -1 1) (random 128))) ;;(loop repeat 100 collect (* (if (zerop (random 2)) -1 1) (random 128)))
;; Unsigned ;; Unsigned
...@@ -89,10 +144,10 @@ ...@@ -89,10 +144,10 @@
(if (member (first form) eval-list) (if (member (first form) eval-list)
(eval form) (eval form)
(mapcar (lambda (se) (mapcar (lambda (se)
(stupid-walk-form-eval-some se eval-list)) (stupid-code-walk-eval-some se eval-list))
form)))) 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)) (iter (for default-element-type in (element-types element-types))
(declare (special default-element-type starting-element)) (declare (special default-element-type starting-element))
(setf starting-element 0) (setf starting-element 0)
...@@ -101,24 +156,20 @@ ...@@ -101,24 +156,20 @@
test test
'(vector-default scalar-default))))) '(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: ;;; doesn't work for complex because:
;;; Cannot pass complex scalars to and from GSL functions (structs passed by value). ;;; 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 ;; Load GSL
;; Liam Healy Sat Mar 4 2006 - 18:53 ;; 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$ ;; $Id$
(defpackage gsll (defpackage gsll
(:nicknames :gsl) (:nicknames :gsl)
(:use :common-lisp :cffi)) (:use :common-lisp :cffi :iterate))
(cffi:define-foreign-library libgslcblas (cffi:define-foreign-library libgslcblas
(:darwin (:or "/opt/local/lib/libgslcblas.dylib" "/usr/local/lib/libgslcblas.dylib")) (:darwin (:or "/opt/local/lib/libgslcblas.dylib" "/usr/local/lib/libgslcblas.dylib"))
......
...@@ -58,21 +58,3 @@ ...@@ -58,21 +58,3 @@
(lisp-unit::expand-assert (lisp-unit::expand-assert
:equal form form expected extras :equal form form expected extras
:test #'numerical-equal)) :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 ;; Airy functions
;; Liam Healy, Fri Mar 17 2006 - 18:41 ;; 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$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -80,6 +80,20 @@ ...@@ -80,6 +80,20 @@
;;;; Examples and unit test ;;;; 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 (make-tests airy
(airy-ai 2.5d0) (airy-ai 2.5d0)
...@@ -146,3 +160,6 @@ Out[6]= -0.02625088103590323 ...@@ -146,3 +160,6 @@ Out[6]= -0.02625088103590323
In[7]:= AiryBiPrime[2.5] In[7]:= AiryBiPrime[2.5]
Out[7]= 9.4214233173343 Out[7]= 9.4214233173343
|# |#
;; Clausen function ;; Clausen function
;; Liam Healy, Sat Mar 18 2006 - 23:18 ;; 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$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -10,12 +10,4 @@ ...@@ -10,12 +10,4 @@
:documentation ; FDL :documentation ; FDL
"The Clausen integral Cl_2(x).") "The Clausen integral Cl_2(x).")
#| (save-tests clausen (clausen 2.5d0))
(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))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment