From 6bb17e919753d78762aa556318f5aaae413496e4 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Mon, 13 Oct 2008 23:29:09 -0400 Subject: [PATCH] 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. --- gsll.asd | 5 +- init/generate-tests.lisp | 83 +++++++++++++++++++++++++++------- init/init.lisp | 4 +- init/tests.lisp | 18 -------- special-functions/airy.lisp | 19 +++++++- special-functions/clausen.lisp | 12 +---- 6 files changed, 92 insertions(+), 49 deletions(-) diff --git a/gsll.asd b/gsll.asd index 352ca80c..ac51e196 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 5bf4a0af..ec4497d1 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 6dea7675..86e1058a 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 9a263fd0..bd30b50c 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 9c757f67..c7c24086 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 be19eb13..ee1f46f6 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)) -- GitLab