From 913040d8a8f676256f9e08b01d6d61d0b053fed5 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Wed, 29 Apr 2009 22:52:02 -0400 Subject: [PATCH] Use FSBV for functions taking complex scalars The BLAS matrix-product functions now work on complex arrays using FSBV, but there are no tests yet. New tests vector-set-all and matrix-set-all replace set-all tests with addition, and work for all types including complex using FSBV. Default optional argument marrays are initialized to 0. Polynomial evaluation with complex argument uncommented, but not yet working. --- data/array-tests.lisp | 20 +++-- gsll-tests.asd | 6 +- init/types.lisp | 8 +- linear-algebra/blas2.lisp | 18 ++++- linear-algebra/blas3.lisp | 14 +++- polynomial.lisp | 8 +- tests/matrix-set-all-add.lisp | 142 --------------------------------- tests/matrix-set-all.lisp | 103 ++++++++++++++++++++++++ tests/vector-set-all-add.lisp | 146 ---------------------------------- tests/vector-set-all.lisp | 120 ++++++++++++++++++++++++++++ 10 files changed, 267 insertions(+), 318 deletions(-) delete mode 100644 tests/matrix-set-all-add.lisp create mode 100644 tests/matrix-set-all.lisp delete mode 100644 tests/vector-set-all-add.lisp create mode 100644 tests/vector-set-all.lisp diff --git a/data/array-tests.lisp b/data/array-tests.lisp index 1d831867..7e958f0a 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: <2009-04-11 22:33:59EDT array-tests.lisp> +;; Time-stamp: <2009-04-29 22:23:37EDT array-tests.lisp> ;; $Id: $ ;;; Generate each file with #'write-test-to-file, e.g. @@ -15,17 +15,13 @@ ;;;; Bulk operations ;;;;**************************************************************************** -(generate-all-array-tests vector-set-all-add t - (let ((v1 (array-default 3 t)) - (v2 (array-default 3))) - (set-all v1 (scalar-default)) - (cl-array (elt+ v1 v2)))) +(generate-all-array-tests vector-set-all t + (let ((v1 (array-default 3 t))) + (cl-array (set-all v1 (scalar-default))))) -(generate-all-array-tests matrix-set-all-add t - (let ((m1 (array-default '(3 3) t)) - (m2 (array-default '(3 3)))) - (set-all m1 (scalar-default)) - (cl-array (elt+ m1 m2)))) +(generate-all-array-tests matrix-set-all t + (let ((m1 (array-default '(3 3) t))) + (cl-array (set-all m1 (scalar-default))))) (generate-all-array-tests vector-set-zero t (let ((v1 (array-default 3))) @@ -59,6 +55,8 @@ ;;;; Arithmetic operations ;;;;**************************************************************************** +;;; In GSL versions >= 1.12, :no-complex can be changed to T. + (generate-all-array-tests vector-add :no-complex (let ((v1 (array-default 3)) (v2 (array-default 3))) diff --git a/gsll-tests.asd b/gsll-tests.asd index 8ff12334..74b001bf 100644 --- a/gsll-tests.asd +++ b/gsll-tests.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-03-16 19:02:05EDT gsll-tests.asd> +;; Time-stamp: <2009-04-29 22:25:14EDT gsll-tests.asd> (asdf:defsystem "gsll-tests" :name "gsll-tests" @@ -104,7 +104,7 @@ (:file "matrix-product-nonsquare") (:file "matrix-product-symmetric") (:file "matrix-product-triangular") - (:file "matrix-set-all-add") + (:file "matrix-set-all") (:file "matrix-set-zero") (:file "matrix-standard-deviation") (:file "matrix-standard-deviation-with-fixed-mean") @@ -177,7 +177,7 @@ (:file "vector-add") (:file "vector-mult") (:file "vector-reverse") - (:file "vector-set-all-add") + (:file "vector-set-all") (:file "vector-set-zero") (:file "vector-standard-deviation") (:file "vector-standard-deviation-with-fixed-mean") diff --git a/init/types.lisp b/init/types.lisp index 9720bcba..ace07569 100644 --- a/init/types.lisp +++ b/init/types.lisp @@ -1,6 +1,6 @@ ;; Number types used by GSL functions, and specification conversion ;; Liam Healy 2008-12-31 21:06:34EST types.lisp -;; Time-stamp: <2009-01-13 22:00:26EST types.lisp> +;; Time-stamp: <2009-04-29 22:48:31EDT types.lisp> ;; $Id: $ (in-package :gsl) @@ -13,10 +13,12 @@ (cffi:foreign-type-size :long) (8 (push :int64 *features*) - (cffi:defctype sizet :uint64)) + (cffi:defctype sizet :uint64) + (fsbv:defsynonym sizet :uint64)) (4 (push :int32 *features*) - (cffi:defctype sizet :uint32)) + (cffi:defctype sizet :uint32) + (fsbv:defsynonym sizet :uint64)) (t (error "Size of :long unrecognized"))) ;;;;**************************************************************************** diff --git a/linear-algebra/blas2.lisp b/linear-algebra/blas2.lisp index 7f43287c..e5d7b83c 100644 --- a/linear-algebra/blas2.lisp +++ b/linear-algebra/blas2.lisp @@ -1,6 +1,6 @@ ;; BLAS level 2, Matrix-vector operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2009-03-15 17:09:00EDT blas2.lisp> +;; Time-stamp: <2009-04-29 20:38:03EDT blas2.lisp> ;; $Id$ (in-package :gsl) @@ -15,14 +15,20 @@ "CBLAS_TRANSPOSE from /usr/include/gsl/gsl_cblas.h." (:notrans 111) :trans :conjtrans) +(fsbv:defcenum-aux cblas-transpose) + (cffi:defcenum cblas-uplo "/usr/include/gsl/gsl_cblas.h." (:upper 121) :lower) +(fsbv:defcenum-aux cblas-uplo) + (cffi:defcenum cblas-diag "/usr/include/gsl/gsl_cblas.h." (:nonunit 131) :unit) +(fsbv:defcenum-aux cblas-diag) + ;;;;**************************************************************************** ;;;; Functions ;;;;**************************************************************************** @@ -37,7 +43,9 @@ (defmfun matrix-product ((A matrix) (x vector) &optional - (y (make-marray element-type :dimensions (matrix-product-dimensions A x))) + (y (make-marray + element-type :dimensions (matrix-product-dimensions A x) + :initial-element 0)) (alpha 1) (beta 1) (TransA :notrans) TransB) ("gsl_blas_" :type "gemv") ((transa cblas-transpose) (alpha :element-c-type) ((mpointer A) :pointer) @@ -123,7 +131,8 @@ (defmfun matrix-product-symmetric ((A matrix) (x vector) &optional - (y (make-marray element-type :dimensions (matrix-product-dimensions A x))) + (y (make-marray element-type :dimensions (matrix-product-dimensions A x) + :initial-element 0)) (alpha 1) (beta 1) (uplo :upper) (side :left)) ("gsl_blas_" :type "symv") ((uplo cblas-uplo) (alpha :element-c-type) ((mpointer A) :pointer) @@ -151,7 +160,8 @@ (defmfun matrix-product-hermitian ((A matrix) (x vector) &optional - (y (make-marray element-type :dimensions (matrix-product-dimensions A x))) + (y (make-marray element-type :dimensions (matrix-product-dimensions A x) + :initial-element 0)) (alpha 1) (beta 1) (uplo :upper) (side :left)) ;; This always signals an error because you can't pass a ;; struct in CFFI yet. diff --git a/linear-algebra/blas3.lisp b/linear-algebra/blas3.lisp index 186792bb..5bba4439 100644 --- a/linear-algebra/blas3.lisp +++ b/linear-algebra/blas3.lisp @@ -1,6 +1,6 @@ ;; BLAS level 3, Matrix-matrix operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2009-03-15 17:15:40EDT blas3.lisp> +;; Time-stamp: <2009-04-29 20:36:48EDT blas3.lisp> ;; $Id$ (in-package :gsl) @@ -15,6 +15,8 @@ "/usr/include/gsl/gsl_cblas.h." (:left 141) :right) +(fsbv:defcenum-aux cblas-side) + ;;;;**************************************************************************** ;;;; Functions ;;;;**************************************************************************** @@ -22,7 +24,9 @@ (defmfun matrix-product ((A matrix) (B matrix) &optional - (C (make-marray element-type :dimensions (matrix-product-dimensions A B))) + (C (make-marray + element-type + :dimensions (matrix-product-dimensions A B) :initial-element 0)) (alpha 1) (beta 1) (TransA :notrans) (TransB :notrans)) ("gsl_blas_" :type "gemm") ((TransA cblas-transpose) (TransB cblas-transpose) @@ -36,7 +40,8 @@ (defmfun matrix-product-symmetric ((A matrix) (B matrix) &optional - (C (make-marray element-type :dimensions (matrix-product-dimensions A B))) + (C (make-marray element-type :dimensions (matrix-product-dimensions A B) + :initial-element 0)) (alpha 1) (beta 1) (uplo :upper) (side :left)) ("gsl_blas_" :type "symm") ((side cblas-side) (uplo cblas-uplo) (alpha :element-c-type) @@ -50,7 +55,8 @@ (defmfun matrix-product-hermitian ((A matrix) (B matrix) &optional - (C (make-marray element-type :dimensions (matrix-product-dimensions A B))) + (C (make-marray element-type :dimensions (matrix-product-dimensions A B) + :initial-element 0)) (alpha 1) (beta 1) (uplo :upper) (side :left)) ;; This always signals an error because you can't pass a ;; struct in CFFI yet. diff --git a/polynomial.lisp b/polynomial.lisp index 55c8182f..d6511efe 100644 --- a/polynomial.lisp +++ b/polynomial.lisp @@ -1,6 +1,6 @@ ;; Polynomials ;; Liam Healy, Tue Mar 21 2006 - 18:33 -;; Time-stamp: <2009-04-27 21:25:42EDT polynomial.lisp> +;; Time-stamp: <2009-04-29 22:34:47EDT polynomial.lisp> ;; $Id$ (in-package :gsl) @@ -26,11 +26,10 @@ :documentation ; FDL "Evaluate the polyonomial with coefficients at the point x.") -#| ;;; These won't work until we can take returned complex (structs). (defmfun evaluate ((coefficients vector-double-float) (x complex) - &key &allow-other-keys) + &key) "gsl_poly_complex_eval" (((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet) (x complex-double-c)) @@ -43,7 +42,7 @@ (defmfun evaluate ((coefficients vector-complex-double-float) (x complex) - &key &allow-other-keys) + &key) "gsl_complex_poly_complex_eval" (((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet) (x complex-double-c)) @@ -53,7 +52,6 @@ :c-return complex-double-c :documentation ; FDL "Evaluate the polyonomial with coefficients at the complex value x.") -|# ;;;;**************************************************************************** ;;;; Divided Difference Representation of Polynomials diff --git a/tests/matrix-set-all-add.lisp b/tests/matrix-set-all-add.lisp deleted file mode 100644 index 49fdd562..00000000 --- a/tests/matrix-set-all-add.lisp +++ /dev/null @@ -1,142 +0,0 @@ -;; Regression test MATRIX-SET-ALL-ADD for GSLL, automatically generated - -(in-package :gsl) - -(LISP-UNIT:DEFINE-TEST MATRIX-SET-ALL-ADD - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((8.23 50.97 46.02) - (33.8 76.85 36.579998) - (92.0 29.24 75.229996))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3))) - (M2 - (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '((-34.5 8.24 3.29) - (-8.93 34.12 -6.15) - (49.27 -13.49 32.5))))) - (SET-ALL M1 42.73) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((8.229999999999997d0 50.97d0 46.019999999999996d0) - (33.8d0 76.85d0 36.58d0) - (92.0d0 29.239999999999995d0 - 75.22999999999999d0))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3))) - (M2 - (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '((-34.5d0 8.24d0 3.29d0) - (-8.93d0 34.12d0 -6.15d0) - (49.27d0 -13.49d0 32.5d0))))) - (SET-ALL M1 42.73d0) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 -101))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 8) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 8) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 8) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 155))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 16) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 16) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 16) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 155))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 32) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 32) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 155))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 64) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 64) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 64) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2)))))) - diff --git a/tests/matrix-set-all.lisp b/tests/matrix-set-all.lisp new file mode 100644 index 00000000..44cb017b --- /dev/null +++ b/tests/matrix-set-all.lisp @@ -0,0 +1,103 @@ +;; Regression test MATRIX-SET-ALL for GSLL, automatically generated + +(in-package :gsl) + +(LISP-UNIT:DEFINE-TEST MATRIX-SET-ALL + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((-34.5 -34.5 -34.5) + (-34.5 -34.5 -34.5) + (-34.5 -34.5 -34.5))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 -34.5))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((-34.5d0 -34.5d0 -34.5d0) + (-34.5d0 -34.5d0 -34.5d0) + (-34.5d0 -34.5d0 -34.5d0))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 -34.5d0))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24)) + (#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24)) + (#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24)))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) + :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 #C(-34.5 8.24)))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0)) + (#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0)) + (#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0)))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) + :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 #C(-34.5d0 8.24d0)))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 8) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 8) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 16) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 32) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 64) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67)))))) + diff --git a/tests/vector-set-all-add.lisp b/tests/vector-set-all-add.lisp deleted file mode 100644 index af7b307f..00000000 --- a/tests/vector-set-all-add.lisp +++ /dev/null @@ -1,146 +0,0 @@ -;; Regression test VECTOR-SET-ALL-ADD for GSLL, automatically generated - -(in-package :gsl) - -(LISP-UNIT:DEFINE-TEST VECTOR-SET-ALL-ADD - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-43.43 -0.69000053 -5.6400003)) - (MULTIPLE-VALUE-LIST - (LET ((V1 (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '(-34.5 8.24 3.29)))) - (SET-ALL V1 -8.93) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-43.43d0 -0.6899999999999995d0 -5.64d0)) - (MULTIPLE-VALUE-LIST - (LET ((V1 (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(-34.5d0 8.24d0 3.29d0)))) - (SET-ALL V1 -8.93d0) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(101 97 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(SIGNED-BYTE - 8) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(SIGNED-BYTE - 8) - :INITIAL-CONTENTS - '(-64 -68 - 71)))) - (SET-ALL V1 -91) - (CL-ARRAY - (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 49)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 8) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 8) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-155 -159 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY '(SIGNED-BYTE 16) - :INITIAL-CONTENTS '(-64 -68 71)))) - (SET-ALL V1 -91) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 305)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 16) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 16) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-155 -159 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTENTS '(-64 -68 71)))) - (SET-ALL V1 -91) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 305)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 32) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 32) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-155 -159 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY '(SIGNED-BYTE 64) - :INITIAL-CONTENTS '(-64 -68 71)))) - (SET-ALL V1 -91) - (CL-ARRAY (ELT+ V1 V2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 305)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 64) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 64) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2)))))) - diff --git a/tests/vector-set-all.lisp b/tests/vector-set-all.lisp new file mode 100644 index 00000000..82639074 --- /dev/null +++ b/tests/vector-set-all.lisp @@ -0,0 +1,120 @@ +;; Regression test VECTOR-SET-ALL for GSLL, automatically generated + +(in-package :gsl) + +(LISP-UNIT:DEFINE-TEST VECTOR-SET-ALL + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #(-34.5 -34.5 -34.5)) + (MULTIPLE-VALUE-LIST + (LET ((V1 (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 -34.5))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #(-34.5d0 -34.5d0 -34.5d0)) + (MULTIPLE-VALUE-LIST + (LET ((V1 (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 -34.5d0))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #(#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24))) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) + :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 #C(-34.5 8.24)))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #(#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0))) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) + :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 #C(-34.5d0 8.24d0)))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 8) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 8) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 16) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 16) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 32) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 32) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 64) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 64) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67)))))) + -- GitLab