From 32b971a4d358eeacff3bd1b5d97eb2695b93e0b1 Mon Sep 17 00:00:00 2001
From: Liam Healy <liam@thinkpad.local>
Date: Sat, 8 Nov 2008 20:51:56 -0500
Subject: [PATCH] Complete "both" array tests

Complete set of tests on array operations that are defined for both
vectors and matrices.  Added documentation to generate-tests to
explain how it works and why it's there.  Fixed bug in
#'expand-defmfun-generic that occured when both arrays are generated,
due to key-args being altered.
---
 data/array-tests.lisp            | 128 ++++++++++++++++++++++++++++++-
 data/both.lisp                   |  24 +++---
 documentation/documentation.html |  14 ++--
 init/defmfun.lisp                |   6 +-
 init/generate-tests.lisp         |  24 +++++-
 5 files changed, 176 insertions(+), 20 deletions(-)

diff --git a/data/array-tests.lisp b/data/array-tests.lisp
index 04d189b3..a7de25eb 100644
--- a/data/array-tests.lisp
+++ b/data/array-tests.lisp
@@ -1,6 +1,6 @@
 ;; Tests of array functions 
 ;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp
-;; Time-stamp: <2008-11-02 18:07:27EST array-tests.lisp>
+;; Time-stamp: <2008-11-08 19:04:34EST array-tests.lisp>
 ;; $Id: $
 
 ;;; Generate each file with #'write-test-to-file, e.g.
@@ -11,6 +11,10 @@
 ;;; Some of these don't work for complex because:
 ;;; Cannot pass complex scalars to and from GSL functions (structs passed by value).
 
+;;;;****************************************************************************
+;;;; Bulk operations
+;;;;****************************************************************************
+
 (generate-all-array-tests
  vector-set-all-m+ :no-complex
  (letm ((v1 (array-default 3 t))
@@ -64,3 +68,125 @@
 	(m2 (array-default '(3 3))))
    (swap m2 m1)
    (list (cl-array m1) (cl-array m2))))
+
+;;;;****************************************************************************
+;;;; Arithmetic operations
+;;;;****************************************************************************
+
+(generate-all-array-tests vector-m+ :no-complex
+ (letm ((v1 (array-default 3))
+	(v2 (array-default 3)))
+   (cl-array (m+ v1 v2))))
+
+(generate-all-array-tests matrix-m+ :no-complex
+ (letm ((m1 (array-default '(3 3)))
+	(m2 (array-default '(3 3))))
+   (cl-array (m+ m1 m2))))
+
+(generate-all-array-tests vector-m- :no-complex
+ (letm ((v1 (array-default 3))
+	(v2 (array-default 3)))
+   (cl-array (m- v1 v2))))
+
+(generate-all-array-tests matrix-m- :no-complex
+ (letm ((m1 (array-default '(3 3)))
+	(m2 (array-default '(3 3))))
+   (cl-array (m- m1 m2))))
+
+(generate-all-array-tests vector-mult :no-complex
+ (letm ((v1 (array-default 3))
+	(v2 (array-default 3)))
+   (cl-array (m* v1 v2))))
+
+(generate-all-array-tests matrix-mult :no-complex
+ (letm ((m1 (array-default '(3 3)))
+	(m2 (array-default '(3 3))))
+   (cl-array (m* m1 m2))))
+
+(generate-all-array-tests vector-div :no-complex
+ (letm ((v1 (array-default 3))
+	(v2 (array-default 3)))
+   (cl-array (m/ v1 v2))))
+
+(generate-all-array-tests matrix-div :no-complex
+ (letm ((m1 (array-default '(3 3)))
+	(m2 (array-default '(3 3))))
+   (cl-array (m/ m1 m2))))
+
+#|  Temporarily commented out due to GSL bug
+(generate-all-array-tests vector-mult-scalar :no-complex
+ (letm ((v1 (array-default 3))
+	(scalar (scalar-default)))
+   (cl-array (m*c v1 scalar))))
+
+(generate-all-array-tests matrix-mult-scalar :no-complex
+ (letm ((m1 (array-default '(3 3)))
+	(scalar (scalar-default)))
+   (cl-array (m*c m1 scalar))))
+
+(generate-all-array-tests vector-add-scalar :no-complex
+ (letm ((v1 (array-default 3))
+	(scalar (scalar-default)))
+   (cl-array (m+c v1 scalar))))
+
+(generate-all-array-tests matrix-add-scalar :no-complex
+ (letm ((m1 (array-default '(3 3)))
+	(scalar (scalar-default)))
+   (cl-array (m+c m1 scalar))))
+|#
+
+;;;;****************************************************************************
+;;;; Maximum and minimum elements
+;;;;****************************************************************************
+
+(generate-all-array-tests vector-max :no-complex
+ (letm ((v1 (array-default 3)))
+   (mmax v1)))
+
+(generate-all-array-tests matrix-max :no-complex
+ (letm ((m1 (array-default '(3 3))))
+   (mmax m1)))
+
+#| Temporarily commented out twos-complement answer for SIGNED-BYTE-8 and SIGNED-BYTE-16
+(generate-all-array-tests vector-min :no-complex
+ (letm ((v1 (array-default 3)))
+   (mmin v1)))
+
+(generate-all-array-tests matrix-min :no-complex
+ (letm ((m1 (array-default '(3 3))))
+   (mmin m1)))
+|#
+
+(generate-all-array-tests vector-minmax :no-complex
+ (letm ((v1 (array-default 3)))
+   (minmax v1)))
+
+(generate-all-array-tests matrix-minmax :no-complex
+ (letm ((m1 (array-default '(3 3))))
+   (minmax m1)))
+
+(generate-all-array-tests vector-min-index :no-complex
+ (letm ((v1 (array-default 8)))
+   (min-index v1)))
+
+(generate-all-array-tests matrix-min-index :no-complex
+ (letm ((m1 (array-default '(3 3))))
+   (min-index m1)))
+
+(generate-all-array-tests vector-max-index :no-complex
+ (letm ((v1 (array-default 8)))
+   (max-index v1)))
+
+(generate-all-array-tests matrix-max-index :no-complex
+ (letm ((m1 (array-default '(3 3))))
+   (max-index m1)))
+
+(generate-all-array-tests vector-minmax-index :no-complex
+ (letm ((v1 (array-default 8)))
+   (minmax-index v1)))
+
+(generate-all-array-tests matrix-minmax-index :no-complex
+ (letm ((m1 (array-default '(3 3))))
+   (minmax-index m1)))
+
+;;; No test for mzerop yet.
diff --git a/data/both.lisp b/data/both.lisp
index 28daa7c0..1b6aa03c 100644
--- a/data/both.lisp
+++ b/data/both.lisp
@@ -1,6 +1,6 @@
 ;; Functions for both vectors and matrices.
 ;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
-;; Time-stamp: <2008-11-02 18:00:49EST both.lisp>
+;; Time-stamp: <2008-11-08 17:23:47EST both.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -102,11 +102,17 @@
 ;;;; Arithmetic operations
 ;;;;****************************************************************************
 
+;;; Errors in GSL:
+;;; 1) complex operations in older versions of GSL
+;;; https://savannah.gnu.org/bugs/index.php?22478
+;;; 2) Scalar operation m*c, m+c require a double
+;;; for the scalar.  Reported 2008-11-08.
+
 (defmfun m+ ((a both) (b both))
   ("gsl_" :category :type "_add")
   (((mpointer a) :pointer) ((mpointer b) :pointer))
   :definition :generic
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a b)
   :outputs (a)
   :return (a)
@@ -118,7 +124,7 @@
   ("gsl_" :category :type "_sub")
   (((mpointer a) :pointer) ((mpointer b) :pointer))
   :definition :generic
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a b)
   :outputs (a)
   :return (a)
@@ -130,7 +136,7 @@
   ("gsl_" :category :type "_mul")
   (((mpointer a) :pointer) ((mpointer b) :pointer))
   :definition :generic
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a b)
   :outputs (a)
   :return (a)
@@ -142,7 +148,7 @@
   ("gsl_" :category :type "_mul_elements")
   (((mpointer a) :pointer) ((mpointer b) :pointer))
   :definition :methods
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a b)
   :outputs (a)
   :return (a))
@@ -151,7 +157,7 @@
   ("gsl_" :category :type "_div")
   (((mpointer a) :pointer) ((mpointer b) :pointer))
   :definition :generic
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a b)
   :outputs (a)
   :return (a)
@@ -163,7 +169,7 @@
   ("gsl_" :category :type "_div_elements")
   (((mpointer a) :pointer) ((mpointer b) :pointer))
   :definition :methods
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a b)
   :outputs (a)
   :return (a))
@@ -172,7 +178,7 @@
   ("gsl_" :category :type "_scale")
   (((mpointer a) :pointer) (x :element-c-type))
   :definition :generic
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a)
   :outputs (a)
   :return (a)
@@ -183,7 +189,7 @@
   ("gsl_" :category :type "_add_constant")
   (((mpointer a) :pointer) (x :element-c-type))
   :definition :generic
-  :element-types :no-complex		; Question for GSL: why no complex?
+  :element-types :no-complex
   :inputs (a)
   :outputs (a)
   :return (a)
diff --git a/documentation/documentation.html b/documentation/documentation.html
index 7ce4848b..d37b24fe 100644
--- a/documentation/documentation.html
+++ b/documentation/documentation.html
@@ -39,11 +39,13 @@ to find that the Lisp function name is <code>#'jacobian-elliptic-functions</code
    </pre>
    to get an explanation of the arguments etc.
  </li>
- <li>Use the function <code>(examples)</code> to get a list of example
- categories.  Then use the function with a category name as the
- argument to get a list of examples under that category, for
- example 
-   <code>(examples 'higher-moments)</code>.  If the 
+ <li>Use the function <code>(examples)</code> without an argument to
+ get a list of example categories.  Then use the function with a
+ category name as the argument to get a list of examples under that
+ category, for example
+   <code>(examples 'higher-moments)</code>.  The result will be a list
+   of forms, each providing an example of usage in the relevant topic.
+   If the
  <a href="http://www.gnu.org/software/gsl/manual/">GSL documentation</a>
  provides an example, there will usually be the same or similar
  example provided in GSLL.</li>
@@ -201,7 +203,7 @@ gamma-randist, negative-binomial.
     <address><a href="mailto:gsll-devel@common-lisp.net">Liam Healy</a></address>
 <!-- hhmts start -->
     <small>
-      Time-stamp: <2008-10-25 18:59:39EDT documentation.html>
+      Time-stamp: <2008-11-08 14:14:02EST documentation.html>
       </small>
 <!-- hhmts end -->
  </div>
diff --git a/init/defmfun.lisp b/init/defmfun.lisp
index 20fc9b9a..d13f8bc1 100644
--- a/init/defmfun.lisp
+++ b/init/defmfun.lisp
@@ -1,6 +1,6 @@
 ;; Macro for defining GSL functions.
 ;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp
-;; Time-stamp: <2008-09-14 18:10:43EDT defmfun.lisp>
+;; Time-stamp: <2008-11-08 18:10:32EST defmfun.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -223,11 +223,11 @@
 		 (generate-methods
 		  :method 'vector
 		  name arglist gsl-name (actual-array-c-type 'vector c-arguments)
-		  key-args 'vector)
+		  (copy-list key-args) 'vector)
 		 (generate-methods
 		  :method 'matrix
 		  name arglist gsl-name (actual-array-c-type 'matrix c-arguments)
-		  key-args 'matrix)))
+		  (copy-list key-args) 'matrix)))
 	      ;; Generate forms for one category
 	      (generate-methods
 	       :method (first categories)
diff --git a/init/generate-tests.lisp b/init/generate-tests.lisp
index 4d9a030f..92286959 100644
--- a/init/generate-tests.lisp
+++ b/init/generate-tests.lisp
@@ -1,8 +1,26 @@
 ;; Make tests and examples
 ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
-;; Time-stamp: <2008-11-02 17:50:39EST generate-tests.lisp>
+;; Time-stamp: <2008-11-08 15:10:41EST generate-tests.lisp>
 ;; $Id: $
 
+;;; Througout the GSLL interface definition files are #'save-test
+;;; forms.  These serve to define both examples and tests.  Getting an
+;;; example involves calling (examples) to get a list of names, then
+;;; the calling the function with a particular name to get the
+;;; examples, e.g.
+;;; (examples)
+;;; (examples 'matrix-m+)
+
+;;; To do all the tests,
+;;; (lisp-unit:run-tests)
+
+;;; The files that define the tests are in tests/.  These files are
+;;; generated automatically and checked into the repository; they
+;;; shouldn't be changed very often.  Rarely, it may be necessary to
+;;; generate such a file.  In this case, #'write-test-to-file recreates
+;;; the file, e.g.
+;;; (write-test-to-file 'matrix-m+ "test/")
+
 (in-package :gsl)
 
 (export 'examples)
@@ -40,6 +58,10 @@
       (getf *all-generated-tests* ',name))
      :test #'equal)))
 
+;;; This is needed for debugging, to remove the previous definitions.
+(defun delete-test-definition (name)
+  (remf *all-generated-tests* name))
+
 (defun examples (&optional name)
   "If no argument is supplied, list the names of the example categories.
    If a category name is given as the argument, give the list of examples
-- 
GitLab