Commit 3c2e6b25 authored by pfdietz's avatar pfdietz

Initial checkin of tests for CONJUGATE, PHASE, CIS, COMPLEX and COMPLEXP.

parent b3d7f7be
;-*- 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)
;-*- 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)
;-*- 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)
;-*- 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)
......@@ -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")
......
......@@ -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))
;-*- 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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment