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