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