Commit 0380c986 authored by pfdietz's avatar pfdietz

Initial checkin of tests for ASH, INTEGER-LENGTH, INTEGERP, NUMERATOR,...

Initial checkin of tests for ASH, INTEGER-LENGTH, INTEGERP, NUMERATOR, DENOMINATOR, RATIONALP and REALP.
parent 686f9c63
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Sep 7 08:43:03 2003
;;;; Contains: Tests of ASH
(in-package :cl-test)
(deftest ash.error.1
(classify-error (ash))
program-error)
(deftest ash.error.2
(classify-error (ash 1 1 1))
program-error)
(deftest ash.error.3
(classify-error (ash 1 1 nil))
program-error)
(deftest ash.error.4
(loop for x in *mini-universe*
unless (or (integerp x)
(eq (eval `(classify-error (ash ',x 0))) 'type-error))
collect x)
nil)
(deftest ash.error.5
(loop for x in *mini-universe*
unless (or (integerp x)
(eq (eval `(classify-error (ash 0 ',x))) 'type-error))
collect x)
nil)
(deftest ash.1
(loop for x in *integers*
always (eql (ash x 0) x))
t)
(deftest ash.2
(loop for i = (random-fixnum)
for s = (random-from-interval 40)
for ishifted = (ash i s)
repeat 1000
always (eql (floor (* i (expt 2 s))) ishifted))
t)
(deftest ash.3
(let* ((nbits 100)
(bound (expt 2 nbits)))
(loop for i = (random-from-interval bound)
for s = (random-from-interval (+ nbits 20))
for ishifted = (ash i s)
repeat 1000
always (eql (floor (* i (expt 2 s))) ishifted)))
t)
(deftest ash.order.1
(let ((i 0) x y)
(values (ash (progn (setf x (incf i)) 1)
(progn (setf y (incf i)) 2))
i x y))
4 2 1 2)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Sep 7 10:10:10 2003
;;;; Contains: Tests for INTEGER-LENGTH
(in-package :cl-test)
(deftest integer-length.error.1
(classify-error (integer-length))
program-error)
(deftest integer-length.error.2
(classify-error (integer-length 1 1))
program-error)
(deftest integer-length.error.3
(classify-error (integer-length 1 nil))
program-error)
(deftest integer-length.error.4
(loop for x in *mini-universe*
unless (or (integerp x)
(eq (eval `(classify-error (integer-length ',x)))
'type-error))
collect x)
nil)
(deftest integer-length.1
(loop for len from 0 to 100
for i = (1- (ash 1 len))
for vals = (multiple-value-list (integer-length i))
for len2 = (car vals)
always (and (= (length vals) 1)
(eql len len2)))
t)
(deftest integer-length.2
(loop for len from 0 to 100
for i = (ash 1 len)
for vals = (multiple-value-list (integer-length i))
for len2 = (car vals)
always (and (= (length vals) 1)
(eql (1+ len) len2)))
t)
(deftest integer-length.3
(loop for len from 0 to 100
for i = (- (ash 1 len))
for vals = (multiple-value-list (integer-length i))
for len2 = (car vals)
always (and (= (length vals) 1)
(eql len len2)))
t)
(deftest integer-length.4
(loop for len from 0 to 100
for i = (- -1 (ash 1 len))
for vals = (multiple-value-list (integer-length i))
for len2 = (car vals)
always (and (= (length vals) 1)
(eql (1+ len) len2)))
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Sep 7 10:18:34 2003
;;;; Contains: Tests for INTEGERP
(in-package :cl-test)
(deftest integerp.error.1
(classify-error (integerp))
program-error)
(deftest integerp.error.2
(classify-error (integerp 0 0))
program-error)
(deftest integerp.error.3
(classify-error (integerp nil nil))
program-error)
(deftest integerp.1
(loop for i in *integers*
for vals = (multiple-value-list (integerp i))
unless (and (= (length vals) 1)
(first vals))
collect (cons i vals))
nil)
(deftest integerp.2
(loop for x in *universe*
for vals = (multiple-value-list (integerp x))
unless (and (= (length vals) 1)
(if (typep x 'integer)
(first vals)
(not (first vals))))
collect (cons x vals))
nil)
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
(load "round.lsp") (load "round.lsp")
(load "fround.lsp") (load "fround.lsp")
;;; trancdental functions go here ;;; transcendental functions go here
(load "times.lsp") (load "times.lsp")
(load "plus.lsp") (load "plus.lsp")
...@@ -50,6 +50,13 @@ ...@@ -50,6 +50,13 @@
(load "phase.lsp") (load "phase.lsp")
(load "realpart.lsp") (load "realpart.lsp")
(load "imagpart.lsp") (load "imagpart.lsp")
(load "realp.lsp")
(load "numerator-denominator.lsp")
(load "rationalp.lsp")
(load "ash.lsp")
(load "integer-length.lsp")
(load "integerp.lsp")
(load "rational.lsp") (load "rational.lsp")
(load "rationalize.lsp") (load "rationalize.lsp")
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Sep 7 08:24:57 2003
;;;; Contains: Tests of NUMERATOR, DENOMINATOR
(in-package :cl-test)
(compile-and-load "numbers-aux.lsp")
(deftest numerator.error.1
(classify-error (numerator))
program-error)
(deftest numerator.error.2
(classify-error (numerator 1/2 nil))
program-error)
(deftest denominator.error.1
(classify-error (denominator))
program-error)
(deftest denominator.error.2
(classify-error (denominator 1/2 nil))
program-error)
(deftest numerator-denominator.1
(loop for n = (abs (random-fixnum))
for d = (1+ (abs (random-fixnum)))
for g = (gcd n d)
for n1 = (/ n g)
for d1 = (/ d g)
for r = (/ n d)
for n2 = (numerator r)
for d2 = (denominator r)
repeat 1000
unless (and (eql (gcd n1 d1) 1)
(>= n1 0)
(>= d1 1)
(eql n1 n2)
(eql d1 d2))
collect (list n1 d1 r n2 d2))
nil)
(deftest numerator-denominator.2
(let ((bound (expt 10 20)))
(loop
for n = (random-from-interval bound 0)
for d = (random-from-interval bound 1)
for g = (gcd n d)
for n1 = (/ n g)
for d1 = (/ d g)
for r = (/ n d)
for n2 = (numerator r)
for d2 = (denominator r)
repeat 1000
unless (and (eql (gcd n1 d1) 1)
(>= n1 0)
(>= d1 1)
(eql n1 n2)
(eql d1 d2))
collect (list n1 d1 r n2 d2)))
nil)
(deftest numerator-denominator.3
(loop for n = (abs (random-fixnum))
for d = (1+ (abs (random-fixnum)))
for g = (gcd n d)
for n1 = (/ n g)
for d1 = (/ d g)
for r = (/ n (- d))
for n2 = (numerator r)
for d2 = (denominator r)
repeat 1000
unless (and (eql (gcd n1 d1) 1)
(>= n1 0)
(>= d1 1)
(eql n1 (- n2))
(eql d1 d2))
collect (list n1 d1 r n2 d2))
nil)
(deftest numerator-denominator.4
(let ((bound (expt 10 20)))
(loop
for n = (random-from-interval bound 0)
for d = (random-from-interval bound 1)
for g = (gcd n d)
for n1 = (/ n g)
for d1 = (/ d g)
for r = (/ n (- d))
for n2 = (numerator r)
for d2 = (denominator r)
repeat 1000
unless (and (eql (gcd n1 d1) 1)
(>= n1 0)
(>= d1 1)
(eql n1 (- n2))
(eql d1 d2))
collect (list n1 d1 r n2 d2)))
nil)
(deftest numerator-denominator.5
(loop for r in *rationals*
for n = (numerator r)
for d = (denominator r)
unless (and (integerp n)
(integerp d)
(eql (gcd n d) 1)
(>= d 1)
(eql (/ n d) r))
collect (list r n d))
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Sep 7 08:36:31 2003
;;;; Contains: Tests of RATIONALP
(in-package :cl-test)
(deftest rationalp.error.1
(classify-error (rationalp))
program-error)
(deftest rationalp.error.2
(classify-error (rationalp 0 nil))
program-error)
(deftest rationalp.error.3
(classify-error (rationalp 'a 0))
program-error)
(deftest rationalp.1
(loop for x in *rationals*
for vals = (multiple-value-list (rationalp x))
unless (and (= (length vals) 1)
(first vals))
collect (cons x vals))
nil)
(deftest rationalp.2
(loop for x in (set-difference *universe* *rationals*)
for vals = (multiple-value-list (rationalp x))
unless (and (= (length vals) 1)
(null (first vals)))
collect (cons x vals))
nil)
(deftest rationalp.3
(loop for x in *universe*
when (if (typep x 'rational) (not (rationalp x)) (rationalp x))
collect x)
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Sep 7 08:22:06 2003
;;;; Contains: Tests of REALP
(in-package :cl-test)
(deftest realp.error.1
(classify-error (realp))
program-error)
(deftest realp.error.2
(classify-error (realp 0 nil))
program-error)
(deftest realp.error.3
(classify-error (realp nil nil))
program-error)
(deftest realp.1
(notnot-mv (realp 0))
t)
(deftest realp.2
(notnot-mv (realp 0.0))
t)
(deftest realp.3
(realp #c(1 2))
nil)
(deftest realp.4
(notnot-mv (realp 17/13))
t)
(deftest realp.5
(realp 'a)
nil)
(deftest realp.6
(loop for x in *universe*
for vals = (multiple-value-list (realp x))
for p = (car vals)
when (or (/= (length vals) 1)
(if (typep x 'real) (not p) p))
collect (cons x vals))
nil)
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