Skip to content
Snippets Groups Projects
Commit 262a307d authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Replace broken lisp-unit::assert-true, conditionalize Legendre

Workaround broken lisp-unit::assert-true and conditionalize away tests
for Legendre functions that are no longer present in GSL 2. This
reduces the number of errors when running (asdf:test-system :gsll).
parent e6fad7a9
No related branches found
No related tags found
No related merge requests found
;; Legendre functions ;; Legendre functions
;; Liam Healy, Sat Apr 29 2006 - 19:16 ;; Liam Healy, Sat Apr 29 2006 - 19:16
;; Time-stamp: <2016-08-07 19:06:40EDT legendre.lisp> ;; Time-stamp: <2018-07-14 22:45:04EDT legendre.lisp>
;; ;;
;; Copyright 2006, 2007, 2008, 2009, 2011, 2016 Liam M. Healy ;; Copyright 2006, 2007, 2008, 2009, 2011, 2016, 2018 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -307,17 +307,21 @@ ...@@ -307,17 +307,21 @@
(legendre-Q1 3.3d0) (legendre-Q1 3.3d0)
(legendre-Ql 2 3.3d0) (legendre-Ql 2 3.3d0)
(legendre-Plm 4 3 0.5d0) (legendre-Plm 4 3 0.5d0)
#-gsl2
(let ((arr (grid:make-foreign-array 'double-float :dimensions 4))) (let ((arr (grid:make-foreign-array 'double-float :dimensions 4)))
(legendre-Plm-array 2 0.5d0 arr) (legendre-Plm-array 2 0.5d0 arr)
(grid:copy-to arr)) (grid:copy-to arr))
#-gsl2
(let ((val (grid:make-foreign-array 'double-float :dimensions 4)) (let ((val (grid:make-foreign-array 'double-float :dimensions 4))
(deriv (grid:make-foreign-array 'double-float :dimensions 4))) (deriv (grid:make-foreign-array 'double-float :dimensions 4)))
(legendre-Plm-deriv-array 2 0.5d0 val deriv) (legendre-Plm-deriv-array 2 0.5d0 val deriv)
(grid:copy-to deriv)) (grid:copy-to deriv))
(legendre-sphplm 1200 1100 0.3d0) (legendre-sphplm 1200 1100 0.3d0)
#-gsl2
(let ((arr (grid:make-foreign-array 'double-float :dimensions 4))) (let ((arr (grid:make-foreign-array 'double-float :dimensions 4)))
(legendre-sphPlm-array 4 0.5d0 arr) (legendre-sphPlm-array 4 0.5d0 arr)
(grid:copy-to arr)) (grid:copy-to arr))
#-gsl2
(let ((val (grid:make-foreign-array 'double-float :dimensions 4)) (let ((val (grid:make-foreign-array 'double-float :dimensions 4))
(deriv (grid:make-foreign-array 'double-float :dimensions 4))) (deriv (grid:make-foreign-array 'double-float :dimensions 4)))
(legendre-sphPlm-deriv-array 4 0.5d0 val deriv) (legendre-sphPlm-deriv-array 4 0.5d0 val deriv)
......
;; Additional methods for lisp-unit ;; Additional methods for lisp-unit
;; Liam Healy 2009-04-15 23:23:30EDT augment.lisp ;; Liam Healy 2009-04-15 23:23:30EDT augment.lisp
;; Time-stamp: <2014-02-15 18:40:50EST augment.lisp> ;; Time-stamp: <2018-07-14 22:43:03EDT augment.lisp>
;; ;;
;; Copyright 2009, 2011, 2014 Liam M. Healy ;; Copyright 2009, 2011, 2014, 2018 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -96,20 +96,25 @@ ...@@ -96,20 +96,25 @@
;; 1.0, &re) do a check of test_sf_frac_diff, then of the err, then ;; 1.0, &re) do a check of test_sf_frac_diff, then of the err, then
;; the scale (e10), then they (redundantly?) call test_sf_e10. ;; the scale (e10), then they (redundantly?) call test_sf_e10.
;; Others just call test_sf_e10. This attempts to cover both cases. ;; Others just call test_sf_e10. This attempts to cover both cases.
`(lisp-unit::assert-true `(lisp-unit::assert-equal
(multiple-value-bind (val scale err) t
,form (when
(and (multiple-value-bind (val scale err)
(sf-check-single val ,expected-value ,result-tol err) ,form
(= scale ,scale) (and
,(if err-tol `(<= err ,err-tol) t))))) (sf-check-single val ,expected-value ,result-tol err)
(= scale ,scale)
,(if err-tol `(<= err ,err-tol) t)))
t)))
(defmacro assert-posinf (form) (defmacro assert-posinf (form)
`(lisp-unit::assert-true `(lisp-unit::assert-equal
t
(let ((val ,form)) (let ((val ,form))
(and (infinityp val) (plusp val))))) (and (infinityp val) (plusp val)))))
(defmacro assert-neginf (form) (defmacro assert-neginf (form)
`(lisp-unit::assert-true `(lisp-unit::assert-equal
t
(let ((val ,form)) (let ((val ,form))
(and (infinityp val) (minusp val))))) (and (infinityp val) (minusp val)))))
;; Regression test LEGENDRE for GSLL, automatically generated ;; Regression test LEGENDRE for GSLL, automatically generated
;; ;;
;; Copyright 2009, 2014 Liam M. Healy ;; Copyright 2009, 2014, 2018 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -54,12 +54,14 @@ ...@@ -54,12 +54,14 @@
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST -34.099750274012266d0 3.0286662310541114d-14) (LIST -34.099750274012266d0 3.0286662310541114d-14)
(MULTIPLE-VALUE-LIST (LEGENDRE-PLM 4 3 0.5d0))) (MULTIPLE-VALUE-LIST (LEGENDRE-PLM 4 3 0.5d0)))
#-gsl2
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(2.25d0 5.625d0 4.21875d0 -4.921875d0)) (LIST #(2.25d0 5.625d0 4.21875d0 -4.921875d0))
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((ARR (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :DIMENSIONS 4))) (LET ((ARR (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :DIMENSIONS 4)))
(LEGENDRE-PLM-ARRAY 2 0.5d0 ARR) (LEGENDRE-PLM-ARRAY 2 0.5d0 ARR)
(GRID:COPY-TO ARR 'array 'double-float)))) (GRID:COPY-TO ARR 'array 'double-float))))
#-gsl2
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(-3.0d0 3.75d0 33.75d0 55.78125d0)) (LIST #(-3.0d0 3.75d0 33.75d0 55.78125d0))
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
...@@ -72,6 +74,7 @@ ...@@ -72,6 +74,7 @@
(LIST 0.30366280894310793d0 3.5267592419993454d-14) (LIST 0.30366280894310793d0 3.5267592419993454d-14)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LEGENDRE-SPHPLM 1200 1100 0.3d0))) (LEGENDRE-SPHPLM 1200 1100 0.3d0)))
#-gsl2
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST (LIST
#(0.24892463950030283d0 0.4127948151484927d0 #(0.24892463950030283d0 0.4127948151484927d0
...@@ -80,6 +83,7 @@ ...@@ -80,6 +83,7 @@
(LET ((ARR (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :DIMENSIONS 4))) (LET ((ARR (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :DIMENSIONS 4)))
(LEGENDRE-SPHPLM-ARRAY 4 0.5d0 ARR) (LEGENDRE-SPHPLM-ARRAY 4 0.5d0 ARR)
(GRID:COPY-TO ARR 'array 'double-float)))) (GRID:COPY-TO ARR 'array 'double-float))))
#-gsl2
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST (LIST
#(-0.6637990386674741d0 -0.2751965434323283d0 #(-0.6637990386674741d0 -0.2751965434323283d0
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment