diff --git a/ansi-tests/cis.lsp b/ansi-tests/cis.lsp new file mode 100644 index 0000000000000000000000000000000000000000..366e927256fd4d991d2d0d9e24465fe671a6c5bf --- /dev/null +++ b/ansi-tests/cis.lsp @@ -0,0 +1,49 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 6 18:42:15 2003 +;;;; Contains: Tests of CIS + +(in-package :cl-test) + +(compile-and-load "numbers-aux.lsp") + +(deftest cis.error.1 + (classify-error (cis)) + program-error) + +(deftest cis.error.2 + (classify-error (cis 0 nil)) + program-error) + +(deftest cis.1 + (eqlt (cis 0) #c(1.0 0.0)) + t) + +(deftest cis.2 + (loop for x in '(0.0s0 0.0f0 0.0d0 0.0l0) + for vals = (multiple-value-list (cis x)) + for c = (car vals) + unless (and (= (length vals) 1) + (eql c (complex (float 1 x) x))) + collect (cons x vals)) + nil) + +(deftest cis.3 + (loop for x = (random (* 2 pi)) + for c = (cis x) + repeat 1000 + unless (and (complexp c) + (approx= (imagpart c) (sin x)) + (approx= (realpart c) (cos x))) + collect (list x c (cos x) (sin x))) + nil) + +(deftest cis.4 + (loop for x = (random (coerce (* 2 pi) 'single-float)) + for c = (cis x) + repeat 1000 + unless (and (complexp c) + (approx= (imagpart c) (sin x)) + (approx= (realpart c) (cos x))) + collect (list x c (cos x) (sin x))) + nil) diff --git a/ansi-tests/complex.lsp b/ansi-tests/complex.lsp new file mode 100644 index 0000000000000000000000000000000000000000..30fd92209a59bd9036e64da46ffae9c27915e7f3 --- /dev/null +++ b/ansi-tests/complex.lsp @@ -0,0 +1,46 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 6 19:56:29 2003 +;;;; Contains: Tests of COMPLEX + +(in-package :cl-test) + +(deftest complex.error.1 + (classify-error (complex)) + program-error) + +(deftest complex.error.2 + (classify-error (complex 1 1 nil)) + program-error) + +(deftest complex.1 + (loop for x in *rationals* + for c = (complex x) + always (eql c x)) + t) + +(deftest complex.2 + (loop for x in *floats* + for c = (complex x) + always (and (complexp c) + (eql x (realpart c)) + (eql (float 0 x) (imagpart c)))) + t) + +(deftest complex.3 + (loop for x in *rationals* + for c = (complex 0 x) + unless (or (zerop x) + (and (complexp c) + (eql (realpart c) 0) + (eql (imagpart c) x))) + collect (list c x)) + nil) + +(deftest complex.4 + (loop for x in *floats* + for c = (complex 0 x) + always (and (complexp c) + (eql (float 0 x) (realpart c)) + (eql x (imagpart c)))) + t) diff --git a/ansi-tests/complexp.lsp b/ansi-tests/complexp.lsp new file mode 100644 index 0000000000000000000000000000000000000000..09acb468bfa55eb19b2f532f7e93f39e75a1ec0e --- /dev/null +++ b/ansi-tests/complexp.lsp @@ -0,0 +1,28 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 6 21:03:18 2003 +;;;; Contains: Tests for COMPLEXP + +(in-package :cl-test) + +(deftest complexp.error.1 + (classify-error (complexp)) + program-error) + +(deftest complexp.error.2 + (classify-error (complexp 0 0)) + program-error) + +(deftest complexp.error.3 + (classify-error (complexp #C(1 1) nil)) + program-error) + +(deftest complexp.1 + (loop for x in *universe* + for vals = (multiple-value-list (complexp x)) + when (or (/= (length vals) 1) + (if (typep x 'complex) + (not (car vals)) + (car vals))) + collect (cons x vals)) + nil) diff --git a/ansi-tests/conjugate.lsp b/ansi-tests/conjugate.lsp new file mode 100644 index 0000000000000000000000000000000000000000..1dd17a1b8b926a2209080693bd8d475f9d87186c --- /dev/null +++ b/ansi-tests/conjugate.lsp @@ -0,0 +1,63 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 6 21:07:36 2003 +;;;; Contains: Tests of CONJUGATE + +(in-package :cl-test) + +(deftest conjugate.error.1 + (classify-error (conjugate)) + program-error) + +(deftest conjugate.error.2 + (classify-error (conjugate 0 0)) + program-error) + +(deftest conjugate.1 + (loop for x in *reals* + for vals = (multiple-value-list (conjugate x)) + for xc = (car vals) + always (and (= (length vals) 1) + (eql x xc))) + t) + +(deftest conjugate.2 + (loop for x in *complexes* + for vals = (multiple-value-list (conjugate x)) + for xc = (car vals) + always (and (= (length vals) 1) + (eql (realpart x) (realpart xc)) + (eql (- (imagpart x)) (imagpart xc)))) + t) + +(deftest conjugate.3 + (eqlt (conjugate #c(0.0s0 0.0s0)) #c(0.0s0 -0.0s0)) + t) + +(deftest conjugate.4 + (eqlt (conjugate #c(1.0s0 0.0s0)) #c(1.0s0 -0.0s0)) + t) + +(deftest conjugate.5 + (eqlt (conjugate #c(0.0f0 0.0f0)) #c(0.0f0 -0.0f0)) + t) + +(deftest conjugate.6 + (eqlt (conjugate #c(1.0f0 0.0f0)) #c(1.0f0 -0.0f0)) + t) + +(deftest conjugate.7 + (eqlt (conjugate #c(0.0d0 0.0d0)) #c(0.0d0 -0.0d0)) + t) + +(deftest conjugate.8 + (eqlt (conjugate #c(1.0d0 0.0d0)) #c(1.0d0 -0.0d0)) + t) + +(deftest conjugate.9 + (eqlt (conjugate #c(0.0l0 0.0l0)) #c(0.0l0 -0.0l0)) + t) + +(deftest conjugate.10 + (eqlt (conjugate #c(1.0l0 0.0l0)) #c(1.0l0 -0.0l0)) + t) diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp index 528d5b957c2e6878675820d54e49dae4f8872491..906267bd8bcbc1ea2adf7bde608c5f5be22833c7 100644 --- a/ansi-tests/load-numbers.lsp +++ b/ansi-tests/load-numbers.lsp @@ -43,6 +43,11 @@ (load "random-state-p.lsp") (load "make-random-state.lsp") (load "numberp.lsp") +(load "cis.lsp") +(load "complex.lsp") +(load "complexp.lsp") +(load "conjugate.lsp") +(load "phase.lsp") (load "rational.lsp") (load "rationalize.lsp") diff --git a/ansi-tests/numbers-aux.lsp b/ansi-tests/numbers-aux.lsp index 026b107a218f9837fed08a24dd88ed391d27531f..182ddd3d5ddeeeb95a1fd8472c80b6387add96ed 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -245,3 +245,7 @@ until (eql one (+ one next-eps)) do (setq eps next-eps) finally (return (values i eps (float eps one)))))) + +;;; Approximate equality function +(defun approx= (x y &optional (eps (epsilon x))) + (<= (abs (/ (- x y) (max (abs x) 1))) eps)) diff --git a/ansi-tests/phase.lsp b/ansi-tests/phase.lsp new file mode 100644 index 0000000000000000000000000000000000000000..cc4f3f4f82a25661063b05f9a8fe666228e38322 --- /dev/null +++ b/ansi-tests/phase.lsp @@ -0,0 +1,101 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 6 21:15:54 2003 +;;;; Contains: Tests of PHASE + +(in-package :cl-test) + +(deftest phase.error.1 + (classify-error (phase)) + program-error) + +(deftest phase.error.2 + (classify-error (phase 0 0)) + program-error) + +(deftest phase.error.3 + (loop for x in *mini-universe* + unless (or (numberp x) + (eq (eval `(classify-error (phase ',x))) 'type-error)) + collect x) + nil) + +(deftest phase.1 + (eqlt (phase 0) 0.0f0) + t) + +(deftest phase.2 + (eqlt (phase 1) 0.0f0) + t) + +(deftest phase.3 + (eqlt (phase 1/2) 0.0f0) + t) + +(deftest phase.4 + (eqlt (phase 100.0f0) 0.0f0) + t) + +(deftest phase.5 + (eqlt (phase 100.0s0) 0.0s0) + t) + +(deftest phase.6 + (eqlt (phase 100.0d0) 0.0d0) + t) + +(deftest phase.7 + (eqlt (phase 100.0l0) 0.0l0) + t) + +(deftest phase.8 + (eqlt (phase -1) (coerce pi 'single-float)) + t) + +(deftest phase.9 + (eqlt (phase -1/2) (coerce pi 'single-float)) + t) + +(deftest phase.10 + (let ((p1 (phase #c(0 1))) + (p2 (phase #c(0.0f0 1.0f0)))) + (and (eql p1 p2) + (approx= p1 (coerce (/ pi 2) 'single-float)))) + t) + +(deftest phase.11 + (let ((p (phase #c(0.0d0 1.0d0)))) + (approx= p (coerce (/ pi 2) 'double-float))) + t) + +(deftest phase.12 + (let ((p (phase #c(0.0s0 1.0s0)))) + (approx= p (coerce (/ pi 2) 'single-float))) + t) + +(deftest phase.13 + (let ((p (phase #c(0.0l0 1.0l0)))) + (approx= p (/ pi 2))) + t) + +(deftest phase.14 + (let ((p1 (phase #c(1 1))) + (p2 (phase #c(1.0f0 1.0f0)))) + (and (eql p1 p2) + (approx= p1 (coerce (/ pi 4) 'single-float)))) + t) + +(deftest phase.15 + (let ((p (phase #c(1.0d0 1.0d0)))) + (approx= p (coerce (/ pi 4) 'double-float))) + t) + +(deftest phase.16 + (let ((p (phase #c(1.0s0 1.0s0)))) + (approx= p (coerce (/ pi 4) 'single-float))) + t) + +(deftest phase.17 + (let ((p (phase #c(1.0l0 1.0l0)))) + (approx= p (/ pi 4))) + t)