Commit 46532b12 authored by Liam Healy's avatar Liam Healy
Browse files

Add :grid-type keyword to copy function call

The generic function #'copy now needs a keyword argument for the
destination :grid-type.  Eliminate unnecessary copy tests; these are
better tested in grid as they didn't use any GSL functions.
parent ed0605dc
;; Numerical integration
;; Liam Healy, Wed Jul 5 2006 - 23:14
;; Time-stamp: <2010-06-27 18:13:57EDT numerical-integration.lisp>
;; Time-stamp: <2010-07-06 23:26:39EDT numerical-integration.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -367,6 +367,6 @@
(integration-QAGil (integration-test-myfn2 1.0d0) 1.0d0 1.0d-7 0.0d0 1000)
(integration-QAGp
'integration-test-f454
(copy (vector 0.0d0 1.0d0 (sqrt 2.0d0) 3.0d0) 'vector-double-float)
(copy (vector 0.0d0 1.0d0 (sqrt 2.0d0) 3.0d0) :grid-type 'foreign-array)
0.0d0 1.0d-3 1000)
(integration-QAWc 'integration-test-f459 -1.0d0 5.0d0 0.0d0 0.0d0 1.0d-3 1000))
;; Tests of array functions
;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp
;; Time-stamp: <2009-12-27 09:42:06EST array-tests.lisp>
;; Time-stamp: <2010-07-06 23:51:52EDT array-tests.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -48,12 +48,6 @@
(set-zero m1)
(cl-array m1)))
(generate-all-array-tests vector-copy t
(cl-array (copy (array-default 3))))
(generate-all-array-tests matrix-copy t
(cl-array (copy (array-default '(3 3)))))
(generate-all-array-tests vector-swap t
(let ((v1 (array-default 3))
(v2 (array-default 3)))
......
;; Functions for both vectors and matrices.
;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
;; Time-stamp: <2010-07-01 19:38:01EDT both.lisp>
;; Time-stamp: <2010-07-06 22:37:34EDT both.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -68,28 +68,6 @@
:c-return :void
:documentation "Set all elements to 0.")
#|
;;; These will be handled by grid functions/CFFI; do we need to use GSL's routines?
(defmfun grid:copy-to-destination
((source both) (destination both))
("gsl_" :category :type "_memcpy")
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :methods
:inputs (source)
:outputs (destination))
(defmfun grid:copy-making-destination
((source both) &aux
(destination
(grid:make-foreign-array element-type :dimensions (dimensions source))))
("gsl_" :category :type "_memcpy")
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :methods
:inputs (source)
:outputs (destination)
:return (destination))
|#
(defmfun swap ((a both) (b both))
("gsl_" :category :type "_swap")
(((mpointer a) :pointer) ((mpointer b) :pointer))
......
;; Example FFT: transform a pulse (using the "clean" fft interface)
;; Sumant Oemrawsingh, Sat Oct 31 2009 - 00:24
;; Time-stamp: <2010-07-01 19:38:50EDT example.lisp>
;; Time-stamp: <2010-07-06 23:16:03EDT example.lisp>
;;
;; Copyright 2009 Sumant Oemrawsingh, Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -147,7 +147,7 @@
:initial-contents
(map 'list
(lambda (x) (/ x (floor (size backward) stride)))
(copy backward 'array))))))
(copy backward :grid-type 'array))))))
(multiple-value-bind (forward inverse)
(test-real-fft-noise random-vector :stride stride)
(values dft-random-vector forward random-vector inverse)))))
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2010-07-06 22:26:35EDT gsll-tests.asd>
;; Time-stamp: <2010-07-06 23:52:30EDT gsll-tests.asd>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -112,7 +112,6 @@
(:file "lu")
(:file "mathematical")
(:file "mathieu")
(:file "matrix-copy")
(:file "matrix-div")
(:file "matrix-max-index")
(:file "matrix-max")
......@@ -192,7 +191,6 @@
(:file "tdist")
(:file "transport")
(:file "trigonometry")
(:file "vector-copy")
(:file "vector-div")
(:file "vector-max-index")
(:file "vector-max")
......
;; Discrete Hankel Transforms.
;; Liam Healy, Sat Dec 8 2007 - 16:50
;; Time-stamp: <2010-06-30 19:57:28EDT hankel.lisp>
;; Time-stamp: <2010-07-06 23:13:16EDT hankel.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -69,7 +69,8 @@
(save-test hankel ; tests from dht/test.c
(copy (apply-hankel (make-hankel 3 1.0d0 1.0d0) #m(1.0d0 2.0d0 3.0d0)) 'array)
(copy (apply-hankel (make-hankel 3 1.0d0 1.0d0) #m(1.0d0 2.0d0 3.0d0))
:grid-type 'array)
;; Exact, forward-inverse transform should be accurate to 2e-5
(let ((hank (make-hankel 3 1.0d0 1.0d0)))
(copy
......@@ -83,14 +84,16 @@
(loop for n from 0 below 128
do (setf (grid:gref in n)
(/ (1+ (expt (sample-x-hankel hank n) 2)))))
(copy (apply-hankel hank in) 'array))
(copy (apply-hankel hank in)
:grid-type 'array))
;; Integrate[ x exp(-x) J_1(a x), {x,0,Inf}] = a F(3/2, 2; 2; -a^2)
;; expected accuracy only about 2%
(let ((hank (make-hankel 128 1.0d0 20.0d0))
(in (grid:make-foreign-array 'double-float :dimensions 128)))
(loop for n from 0 below 128
do (setf (grid:gref in n) (exp (- (sample-x-hankel hank n)))))
(copy (apply-hankel hank in) 'array))
(copy (apply-hankel hank in)
:grid-type 'array))
;; Integrate[ x^2 (1-x^2) J_1(a x), {x,0,1}] = 2/a^2 J_3(a)
(let ((hank (make-hankel 128 1.0d0 1.0d0))
(in (grid:make-foreign-array 'double-float :dimensions 128)))
......@@ -98,4 +101,4 @@
do (setf (grid:gref in n)
(let ((x (sample-x-hankel hank n)))
(* x (- 1 (expt x 2))))))
(copy (apply-hankel hank in) 'array)))
(copy (apply-hankel hank in) :grid-type 'array)))
;; Generate matrices used in tests of linear algebra functions
;; Liam Healy 2009-09-19 18:28:31EDT matrix-generation.lisp
;; Time-stamp: <2010-07-06 22:29:07EDT matrix-generation.lisp>
;; Time-stamp: <2010-07-06 23:57:49EDT matrix-generation.lisp>
;;
;; Copyright 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -39,8 +39,9 @@
(grid:map-grid
:source function
:destination-specification
`((foreign-array ,dim0 ,dim1) ,element-type)
:source-dims (if dim1 (list dim0 dim1) (list dim0))))
(if dim1
`((foreign-array ,dim0 ,dim1) ,element-type)
`((foreign-array ,dim0) ,element-type))))
(defun constant-matrix
(constant dim0 &optional (dim1 dim0) (element-type 'double-float))
......
;; Polynomials
;; Liam Healy, Tue Mar 21 2006 - 18:33
;; Time-stamp: <2010-06-29 22:15:17EDT polynomial.lisp>
;; Time-stamp: <2010-07-06 23:17:06EDT polynomial.lisp>
;;
;; Copyright 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -211,7 +211,8 @@
(solve-cubic -6.0d0 -13.0d0 42.0d0)
(solve-cubic-complex -1.0d0 1.0d0 -1.0d0)
;; Example from GSL manual
(copy (polynomial-solve #m(-1.0d0 0.0d0 0.0d0 0.0d0 0.0d0 1.0d0)) 'array)
(copy (polynomial-solve #m(-1.0d0 0.0d0 0.0d0 0.0d0 0.0d0 1.0d0))
:grid-type 'array)
;; tests from gsl-1.11/poly/test.c
(evaluate #m(1 0.5 0.3) 0.5d0)
(evaluate #m(1 -1 1 -1 1 -1 1 -1 1 -1 1) 1.0d0)
......@@ -242,15 +243,18 @@
(solve-cubic-complex -57.0d0 1071.0d0 -6647.0d0)
(solve-cubic-complex -11.0d0 -493.0d0 +6647.0d0)
(solve-cubic-complex -143.0d0 5087.0d0 -50065.0d0)
(copy (polynomial-solve #m(-120 274 -225 85 -15 1.0)) 'array)
(copy (polynomial-solve #m(1 0 0 0 1 0 0 0 1)) 'array)
(copy (polynomial-solve #m(-120 274 -225 85 -15 1.0))
:grid-type 'array)
(copy (polynomial-solve #m(1 0 0 0 1 0 0 0 1))
:grid-type 'array)
(let* ((xa #m(0.16 0.97 1.94 2.74 3.58 3.73 4.70))
(ya #m(0.73 1.11 1.49 1.84 2.30 2.41 3.07))
(dd (divided-difference xa ya)))
(list
(copy dd 'array)
(map 'vector (lambda (x) (evaluate xa x :divided-difference dd)) (copy xa 'array))
(copy dd :grid-type 'array)
(map 'vector (lambda (x) (evaluate xa x :divided-difference dd))
(copy xa :grid-type 'array))
(map 'vector
(lambda (x) (evaluate (taylor-divided-difference 1.5d0 dd xa) (- x 1.5d0)))
(copy xa 'array)))))
(copy xa :grid-type 'array)))))
......@@ -29,7 +29,7 @@
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT
:INITIAL-CONTENTS
'(1.0d0 2.0d0 3.0d0)))
'ARRAY)))
:grid-type 'ARRAY)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(1.000011918676266d0 1.9999790476647115d0
......@@ -45,7 +45,7 @@
:INITIAL-CONTENTS
'(1.0d0 2.0d0
3.0d0)))))
'ARRAY))))
:grid-type 'ARRAY))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(3.999613382195876d0 2.9590494996797356d0
......@@ -121,7 +121,7 @@
(1+
(EXPT (SAMPLE-X-HANKEL HANK N)
2)))))
(COPY (APPLY-HANKEL HANK IN) 'ARRAY))))
(COPY (APPLY-HANKEL HANK IN) :grid-type 'ARRAY))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(0.18148296716239096d0 0.29470565030732726d0
......@@ -194,7 +194,7 @@
(LOOP FOR N FROM 0 BELOW 128 DO
(SETF (GRID:GREF IN N)
(EXP (- (SAMPLE-X-HANKEL HANK N)))))
(COPY (APPLY-HANKEL HANK IN) 'ARRAY))))
(COPY (APPLY-HANKEL HANK IN) :grid-type 'ARRAY))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(0.05727421417071144d0 -0.0069532329565967065d0
......@@ -268,5 +268,5 @@
(SETF (GRID:GREF IN N)
(LET ((X (SAMPLE-X-HANKEL HANK N)))
(* X (- 1 (EXPT X 2))))))
(COPY (APPLY-HANKEL HANK IN) 'ARRAY)))))
(COPY (APPLY-HANKEL HANK IN) :grid-type 'ARRAY)))))
......@@ -59,14 +59,15 @@
(let ((lisp-unit:*epsilon* (* 2 1024 1024 double-float-epsilon)))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
(GRID:MAKE-FOREIGN-ARRAY '(COMPLEX DOUBLE-FLOAT) :INITIAL-CONTENTS
'(2.40717272023734d+01 -9.84612797621247d+00
-2.69338853034031d+02 8.75455232472528d+01
2.96661356736296d+03 -1.02624473923993d+03
-1.82073812124749d+04 5.67384473042410d+03
5.57693879019068d+04 -1.61540963210502d+04
-7.88941207561151d+04 1.95053812987858d+04
3.95548551241728d+04 -7.76593696255317d+03)))
(GRID:MAKE-FOREIGN-ARRAY
'(COMPLEX DOUBLE-FLOAT) :INITIAL-CONTENTS
'(#C(2.40717272023734d+01 -9.84612797621247d+00)
#C(-2.69338853034031d+02 8.75455232472528d+01)
#C(2.96661356736296d+03 -1.02624473923993d+03)
#C(-1.82073812124749d+04 5.67384473042410d+03)
#C(5.57693879019068d+04 -1.61540963210502d+04)
#C(-7.88941207561151d+04 1.95053812987858d+04)
#C(3.95548551241728d+04 -7.76593696255317d+03))))
(MULTIPLE-VALUE-LIST
(TEST-LU-SOLVE-DIM (CREATE-COMPLEX-MATRIX 7)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
......@@ -75,18 +76,15 @@
19.679999999999993d0 -5.549999999999997d0))
(MULTIPLE-VALUE-LIST
(LET ((MATRIX
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'((-34.5d0 8.24d0 3.29d0 -8.93d0)
(34.12d0 -6.15d0 49.27d0
-13.49d0)
(32.5d0 42.73d0 -17.24d0
43.31d0)
(-16.12d0 -8.25d0 21.44d0
-49.08d0))))
(GRID:MAKE-FOREIGN-ARRAY
'DOUBLE-FLOAT :INITIAL-CONTENTS
'((-34.5d0 8.24d0 3.29d0 -8.93d0)
(34.12d0 -6.15d0 49.27d0 -13.49d0)
(32.5d0 42.73d0 -17.24d0 43.31d0)
(-16.12d0 -8.25d0 21.44d0 -49.08d0))))
(VEC
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(-39.66d0 -49.46d0 19.68d0
-5.55d0))))
'(-39.66d0 -49.46d0 19.68d0 -5.55d0))))
(MULTIPLE-VALUE-BIND
(MATRIX PERM)
(LU-DECOMPOSITION MATRIX)
......@@ -108,26 +106,19 @@
#C(-30.580000000000002d0 31.67d0)))
(MULTIPLE-VALUE-LIST
(LET ((MATRIX
(GRID:MAKE-FOREIGN-ARRAY '(COMPLEX DOUBLE-FLOAT)
:INITIAL-CONTENTS
'((-34.5d0 8.24d0 3.29d0 -8.93d0
34.12d0 -6.15d0 49.27d0
-13.49d0)
(34.12d0 -6.15d0 49.27d0
-13.49d0 32.5d0 42.73d0
-17.24d0 43.31d0)
(32.5d0 42.73d0 -17.24d0 43.31d0
-16.12d0 -8.25d0 21.44d0
-49.08d0)
(-16.12d0 -8.25d0 21.44d0
-49.08d0 -39.66d0 -49.46d0
19.68d0 -5.55d0))))
(GRID:MAKE-FOREIGN-ARRAY
'(COMPLEX DOUBLE-FLOAT)
:INITIAL-CONTENTS
'((#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) #C(34.12d0 -6.15d0) #C(49.27d0 -13.49d0))
(#C(34.12d0 -6.15d0) #C(49.27d0 -13.49d0) #C(32.5d0 42.73d0) #C(-17.24d0 43.31d0))
(#C(32.5d0 42.73d0) #C(-17.24d0 43.31d0) #C(-16.12d0 -8.25d0) #C(21.44d0 -49.08d0))
(#C(-16.12d0 -8.25d0) #C(21.44d0 -49.08d0) #C(-39.66d0 -49.46d0) #C(19.68d0 -5.55d0)))))
(VEC
(GRID:MAKE-FOREIGN-ARRAY '(COMPLEX DOUBLE-FLOAT)
:INITIAL-CONTENTS
'(-39.66d0 -49.46d0 19.68d0
-5.55d0 -8.82d0 25.37d0 -30.58d0
31.67d0))))
(GRID:MAKE-FOREIGN-ARRAY
'(COMPLEX DOUBLE-FLOAT)
:INITIAL-CONTENTS
'(#C(-39.66d0 -49.46d0) #C(19.68d0 -5.55d0)
#C(-8.82d0 25.37d0) #C(-30.58d0 31.67d0)))))
(MULTIPLE-VALUE-BIND
(MATRIX PERM)
(LU-DECOMPOSITION MATRIX)
......@@ -147,5 +138,5 @@
(CL-ARRAY
(INVERT-MATRIX
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :DIMENSIONS '(2 2)
:INITIAL-CONTENTS
'(1.0d0 2.0d0 3.0d0 4.0d0)))))))
:INITIAL-CONTENTS
'(1.0d0 2.0d0 3.0d0 4.0d0)))))))
;; Regression test MATRIX-COPY for GSLL, automatically generated
;;
;; Copyright 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST MATRIX-COPY
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#2A((-34.5 8.24 3.29)
(-8.93 34.12 -6.15)
(49.27 -13.49 32.5)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
'((-34.5 8.24 3.29) (-8.93 34.12 -6.15)
(49.27 -13.49 32.5)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#2A((-34.5d0 8.24d0 3.29d0)
(-8.93d0 34.12d0 -6.15d0)
(49.27d0 -13.49d0 32.5d0)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'((-34.5d0 8.24d0 3.29d0)
(-8.93d0 34.12d0 -6.15d0)
(49.27d0 -13.49d0 32.5d0)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#2A((#C(-34.5 8.24) #C(3.29 -8.93) #C(34.12 -6.15))
(#C(-8.93 34.12) #C(-6.15 49.27) #C(-13.49 32.5))
(#C(49.27 -13.49) #C(32.5 42.73)
#C(-17.24 43.31))))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(COMPLEX SINGLE-FLOAT)
:INITIAL-CONTENTS
'((-34.5 8.24 3.29 -8.93 34.12 -6.15)
(-8.93 34.12 -6.15 49.27 -13.49 32.5)
(49.27 -13.49 32.5 42.73 -17.24
43.31)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#2A((#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0)
#C(34.12d0 -6.15d0))
(#C(-8.93d0 34.12d0) #C(-6.15d0 49.27d0)
#C(-13.49d0 32.5d0))
(#C(49.27d0 -13.49d0) #C(32.5d0 42.73d0)
#C(-17.24d0 43.31d0))))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(COMPLEX DOUBLE-FLOAT)
:INITIAL-CONTENTS
'((-34.5d0 8.24d0 3.29d0 -8.93d0
34.12d0 -6.15d0)
(-8.93d0 34.12d0 -6.15d0 49.27d0
-13.49d0 32.5d0)
(49.27d0 -13.49d0 32.5d0 42.73d0
-17.24d0 43.31d0)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 44 189) (116 163 140) (161 215 98)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 16) :INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 44 189) (116 163 140) (161 215 98)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 16) :INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32) :INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 44 189) (116 163 140) (161 215 98)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 32) :INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98)))))))
#+int64
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 64) :INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))))
#+int64
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 44 189) (116 163 140) (161 215 98)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 64) :INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98))))))))
......@@ -224,9 +224,8 @@
(MULTIPLE-VALUE-LIST
(INTEGRATION-QAGP 'INTEGRATION-TEST-F454
(COPY
(VECTOR 0.0d0 1.0d0 (SQRT 2.0d0)
3.0d0)
'VECTOR-DOUBLE-FLOAT)
(VECTOR 0.0d0 1.0d0 (SQRT 2.0d0) 3.0d0)
:grid-type 'foreign-array)
0.0d0 0.001d0 1000)))
(let ((lisp-unit:*epsilon* 1.0d-9))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
......
This diff is collapsed.
;; Regression test VECTOR-COPY for GSLL, automatically generated
;;
;; Copyright 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST VECTOR-COPY
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(-34.5 8.24 3.29))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
'(-34.5 8.24 3.29))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(-34.5d0 8.24d0 3.29d0))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(-34.5d0 8.24d0 3.29d0))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(#C(-34.5 8.24) #C(3.29 -8.93) #C(34.12 -6.15)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(COMPLEX SINGLE-FLOAT)
:INITIAL-CONTENTS
'(-34.5 8.24 3.29 -8.93 34.12
-6.15))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0)
#C(34.12d0 -6.15d0)))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY '(COMPLEX DOUBLE-FLOAT)
:INITIAL-CONTENTS
'(-34.5d0 8.24d0 3.29d0 -8.93d0 34.12d0
-6.15d0))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY
'(SIGNED-BYTE 8)
:INITIAL-CONTENTS
'(-64 -68
71))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY
'(UNSIGNED-BYTE
8)
:INITIAL-CONTENTS
'(67 44 189))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY
'(SIGNED-BYTE 16)
:INITIAL-CONTENTS
'(-64 -68
71))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY
'(UNSIGNED-BYTE
16)
:INITIAL-CONTENTS
'(67 44 189))))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71))
(MULTIPLE-VALUE-LIST
(CL-ARRAY
(COPY
(GRID:MAKE-FOREIGN-ARRAY
'(SIGNED-BYTE 32)