From 0380c9861abc66a400c267971d19c5517b0175c5 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sun, 7 Sep 2003 15:19:30 +0000
Subject: [PATCH] Initial checkin of tests for ASH, INTEGER-LENGTH, INTEGERP,
 NUMERATOR, DENOMINATOR, RATIONALP and REALP.

---
 ansi-tests/ash.lsp                   |  62 +++++++++++++++
 ansi-tests/integer-length.lsp        |  62 +++++++++++++++
 ansi-tests/integerp.lsp              |  41 ++++++++++
 ansi-tests/load-numbers.lsp          |   9 ++-
 ansi-tests/numerator-denominator.lsp | 112 +++++++++++++++++++++++++++
 ansi-tests/rationalp.lsp             |  42 ++++++++++
 ansi-tests/realp.lsp                 |  49 ++++++++++++
 7 files changed, 376 insertions(+), 1 deletion(-)
 create mode 100644 ansi-tests/ash.lsp
 create mode 100644 ansi-tests/integer-length.lsp
 create mode 100644 ansi-tests/integerp.lsp
 create mode 100644 ansi-tests/numerator-denominator.lsp
 create mode 100644 ansi-tests/rationalp.lsp
 create mode 100644 ansi-tests/realp.lsp

diff --git a/ansi-tests/ash.lsp b/ansi-tests/ash.lsp
new file mode 100644
index 00000000..fc03ec1b
--- /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 00000000..8cdabc74
--- /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 00000000..24fc6d24
--- /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 1eb19a48..f66c49f3 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 00000000..0af391b2
--- /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 00000000..f1d2ed9c
--- /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 00000000..54380ada
--- /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)
+
+
-- 
GitLab