diff --git a/ansi-tests/ash.lsp b/ansi-tests/ash.lsp new file mode 100644 index 0000000000000000000000000000000000000000..fc03ec1b79d84142777d4d102febad12621db73b --- /dev/null +++ b/ansi-tests/ash.lsp @@ -0,0 +1,62 @@ +;-*- 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) diff --git a/ansi-tests/integer-length.lsp b/ansi-tests/integer-length.lsp new file mode 100644 index 0000000000000000000000000000000000000000..8cdabc74455f5a42ca17ef67deb1431de8b9fcdd --- /dev/null +++ b/ansi-tests/integer-length.lsp @@ -0,0 +1,62 @@ +;-*- 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) diff --git a/ansi-tests/integerp.lsp b/ansi-tests/integerp.lsp new file mode 100644 index 0000000000000000000000000000000000000000..24fc6d247d90937f026bfba009b2215ed0132577 --- /dev/null +++ b/ansi-tests/integerp.lsp @@ -0,0 +1,41 @@ +;-*- 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) + + + + + diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp index 1eb19a48b2c638e78a61ba16c83a85c42b297ee3..f66c49f3c677b8516ff5a7cefd9c3cd006448933 100644 --- a/ansi-tests/load-numbers.lsp +++ b/ansi-tests/load-numbers.lsp @@ -21,7 +21,7 @@ (load "round.lsp") (load "fround.lsp") -;;; trancdental functions go here +;;; transcendental functions go here (load "times.lsp") (load "plus.lsp") @@ -50,6 +50,13 @@ (load "phase.lsp") (load "realpart.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 "rationalize.lsp") diff --git a/ansi-tests/numerator-denominator.lsp b/ansi-tests/numerator-denominator.lsp new file mode 100644 index 0000000000000000000000000000000000000000..0af391b2e5e1f56ea368898748aabf12ce348248 --- /dev/null +++ b/ansi-tests/numerator-denominator.lsp @@ -0,0 +1,112 @@ +;-*- 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) diff --git a/ansi-tests/rationalp.lsp b/ansi-tests/rationalp.lsp new file mode 100644 index 0000000000000000000000000000000000000000..f1d2ed9cc60758ed752750517528e905c93ddbc9 --- /dev/null +++ b/ansi-tests/rationalp.lsp @@ -0,0 +1,42 @@ +;-*- 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) + + diff --git a/ansi-tests/realp.lsp b/ansi-tests/realp.lsp new file mode 100644 index 0000000000000000000000000000000000000000..54380ada2999e0dff7b9536429c919a3b3757a88 --- /dev/null +++ b/ansi-tests/realp.lsp @@ -0,0 +1,49 @@ +;-*- 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) + +