From 2fbeb6ddf78ad72bb81dd3f261606e000fbbb450 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Fri, 12 Sep 2003 02:36:48 +0000
Subject: [PATCH] Initial checkin for tests of BYTE, BYTE-SIZE, BYTE-POSITION,
 DEPOSIT-FIELD, DPB, LDB, MASK-FIELD

---
 ansi-tests/byte.lsp          | 52 +++++++++++++++++++++
 ansi-tests/deposit-field.lsp | 80 +++++++++++++++++++++++++++++++
 ansi-tests/dpb.lsp           | 80 +++++++++++++++++++++++++++++++
 ansi-tests/ldb.lsp           | 89 +++++++++++++++++++++++++++++++++++
 ansi-tests/load-numbers.lsp  |  8 ++++
 ansi-tests/mask-field.lsp    | 91 ++++++++++++++++++++++++++++++++++++
 6 files changed, 400 insertions(+)
 create mode 100644 ansi-tests/byte.lsp
 create mode 100644 ansi-tests/deposit-field.lsp
 create mode 100644 ansi-tests/dpb.lsp
 create mode 100644 ansi-tests/ldb.lsp
 create mode 100644 ansi-tests/mask-field.lsp

diff --git a/ansi-tests/byte.lsp b/ansi-tests/byte.lsp
new file mode 100644
index 00000000..f4c8351f
--- /dev/null
+++ b/ansi-tests/byte.lsp
@@ -0,0 +1,52 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Thu Sep 11 20:13:22 2003
+;;;; Contains: Tests of BYTE, BYTE-SIZE, and BYTE-POSITION
+
+(in-package :cl-test)
+
+(deftest byte.error.1
+  (classify-error (byte))
+  program-error)
+
+(deftest byte.error.2
+  (classify-error (byte 1))
+  program-error)
+
+(deftest byte.error.3
+  (classify-error (byte 1 1 nil))
+  program-error)
+
+(deftest byte.1
+  (progn (byte 0 0) :good)
+  :good)
+
+(deftest byte.2
+  (progn (byte 1 1) :good)
+  :good)
+
+(deftest byte.3
+  (loop for i from 0 to 100
+	always
+	(loop for j from 0 to 100
+	      always
+	      (let ((bspec (byte i j)))
+		(and (eql i (byte-size bspec))
+		     (eql j (byte-position bspec))))))
+  t)
+
+(deftest byte-position.error.1
+  (classify-error (byte-position))
+  program-error)
+
+(deftest byte-position.error.2
+  (classify-error (byte-position (byte 1 1) nil))
+  program-error)
+
+(deftest byte-size.error.1
+  (classify-error (byte-size))
+  program-error)
+
+(deftest byte-size.error.2
+  (classify-error (byte-size (byte 1 1) nil))
+  program-error)
diff --git a/ansi-tests/deposit-field.lsp b/ansi-tests/deposit-field.lsp
new file mode 100644
index 00000000..3a9dee1d
--- /dev/null
+++ b/ansi-tests/deposit-field.lsp
@@ -0,0 +1,80 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Thu Sep 11 20:23:15 2003
+;;;; Contains: Tests of DEPOSIT-FIELD
+
+(in-package :cl-test)
+
+(deftest deposit-field.error.1
+  (classify-error (deposit-field))
+  program-error)
+
+(deftest deposit-field.error.2
+  (classify-error (deposit-field 1))
+  program-error)
+
+(deftest deposit-field.error.3
+  (classify-error (deposit-field 1 (byte 1 0)))
+  program-error)
+
+(deftest deposit-field.error.4
+  (classify-error (deposit-field 1 (byte 1 0) 0 nil))
+  program-error)
+
+(deftest deposit-field.1
+  (loop for pos = (random 32)
+	for size = (random 32)
+	for newbyte = (random (ash 1 (+ pos size)))
+	for val = (random (1+ (random (ash 1 (+ pos size)))))
+	for result = (deposit-field newbyte (byte size pos) val)
+	repeat 100
+	unless
+	(loop for i from 0 to (+ pos size)
+	      always (if (or (< i pos)
+			     (>= i (+ pos size)))
+			 (if (logbitp i val) (logbitp i result)
+			   (not (logbitp i result)))
+		       (if (logbitp i newbyte) (logbitp i result)
+			   (not (logbitp i result)))))
+	collect (list pos size newbyte val result))
+  nil)
+
+(deftest deposit-field.2
+  (loop for pos = (random 1000)
+	for size = (random 1000)
+	for newbyte = (random (ash 1 (+ pos size)))
+	for val = (random (1+ (random (ash 1 (+ pos size)))))
+	for result = (deposit-field newbyte (byte size pos) val)
+	repeat 100
+	unless
+	(loop for i from 0 to (+ pos size)
+	      always (if (or (< i pos)
+			     (>= i (+ pos size)))
+			 (if (logbitp i val) (logbitp i result)
+			   (not (logbitp i result)))
+		       (if (logbitp i newbyte) (logbitp i result)
+			   (not (logbitp i result)))))
+	collect (list pos size newbyte val result))
+  nil)
+
+(deftest deposit-field.3
+  (loop for x = (random-fixnum)
+	for y = (random-fixnum)
+	for pos = (random 32)
+	repeat 100
+	always (= (deposit-field x (byte 0 pos) y) y))
+  t)
+
+(deftest deposit-field.4
+  (let ((bound (ash 1 200)))
+    (loop for x = (random-from-interval bound)
+	  for y = (random-from-interval bound)
+	  for pos = (random 200)
+	  repeat 100
+	  always (= (deposit-field x (byte 0 pos) y) y)))
+  t)
+
+(deftest deposit-field.5
+  (loop for i of-type fixnum from -1000 to 1000
+	always (eql (deposit-field -1 (byte 0 0) i) i))
+  t)
diff --git a/ansi-tests/dpb.lsp b/ansi-tests/dpb.lsp
new file mode 100644
index 00000000..d4fb2315
--- /dev/null
+++ b/ansi-tests/dpb.lsp
@@ -0,0 +1,80 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Thu Sep 11 20:43:54 2003
+;;;; Contains: Tests of DPB
+
+(in-package :cl-test)
+
+(deftest dpb.error.1
+  (classify-error (dpb))
+  program-error)
+
+(deftest dpb.error.2
+  (classify-error (dpb 1))
+  program-error)
+
+(deftest dpb.error.3
+  (classify-error (dpb 1 (byte 1 0)))
+  program-error)
+
+(deftest dpb.error.4
+  (classify-error (dpb 1 (byte 1 0) 0 nil))
+  program-error)
+
+(deftest dpb.1
+  (loop for pos = (random 32)
+	for size = (random 32)
+	for newbyte = (random (ash 1 (+ pos size)))
+	for val = (random (1+ (random (ash 1 (+ pos size)))))
+	for result = (dpb newbyte (byte size pos) val)
+	repeat 100
+	unless
+	(loop for i from 0 to (+ pos size)
+	      always (if (or (< i pos)
+			     (>= i (+ pos size)))
+			 (if (logbitp i val) (logbitp i result)
+			   (not (logbitp i result)))
+		       (if (logbitp (- i pos) newbyte) (logbitp i result)
+			   (not (logbitp i result)))))
+	collect (list pos size newbyte val result))
+  nil)
+
+(deftest dpb.2
+  (loop for pos = (random 1000)
+	for size = (random 1000)
+	for newbyte = (random (ash 1 (+ pos size)))
+	for val = (random (1+ (random (ash 1 (+ pos size)))))
+	for result = (dpb newbyte (byte size pos) val)
+	repeat 100
+	unless
+	(loop for i from 0 to (+ pos size)
+	      always (if (or (< i pos)
+			     (>= i (+ pos size)))
+			 (if (logbitp i val) (logbitp i result)
+			   (not (logbitp i result)))
+		       (if (logbitp (- i pos) newbyte) (logbitp i result)
+			   (not (logbitp i result)))))
+	collect (list pos size newbyte val result))
+  nil)
+
+(deftest dpb.3
+  (loop for x = (random-fixnum)
+	for y = (random-fixnum)
+	for pos = (random 32)
+	repeat 100
+	always (= (dpb x (byte 0 pos) y) y))
+  t)
+
+(deftest dpb.4
+  (let ((bound (ash 1 200)))
+    (loop for x = (random-from-interval bound)
+	  for y = (random-from-interval bound)
+	  for pos = (random 200)
+	  repeat 100
+	  always (= (dpb x (byte 0 pos) y) y)))
+  t)
+
+(deftest dpb.5
+  (loop for i of-type fixnum from -1000 to 1000
+	always (eql (dpb -1 (byte 0 0) i) i))
+  t)
diff --git a/ansi-tests/ldb.lsp b/ansi-tests/ldb.lsp
new file mode 100644
index 00000000..33205d6c
--- /dev/null
+++ b/ansi-tests/ldb.lsp
@@ -0,0 +1,89 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Thu Sep 11 20:45:17 2003
+;;;; Contains: Tests of LDB
+
+(in-package :cl-test)
+
+(deftest ldb.error.1
+  (classify-error (ldb))
+  program-error)
+
+(deftest ldb.error.2
+  (classify-error (ldb (byte 1 1)))
+  program-error)
+
+(deftest ldb.error.3
+  (classify-error (ldb (byte 1 1) -1 0))
+  program-error)
+
+(deftest ldb.1
+  (loop for x = (random-fixnum)
+	for pos = (random 30)
+	for size = (random 30)
+	repeat 10000
+	unless (eql (ldb (byte size pos) x)
+		    (logand (1- (ash 1 size))
+			    (ash x (- pos))))
+	collect (list x pos size))
+  nil)
+
+
+(deftest ldb.2
+  (let ((bound (ash 1 300)))
+    (loop for x = (random-from-interval bound)
+	  for pos = (random 300)
+	  for size = (random 300)
+	  repeat 1000
+	  unless (eql (ldb (byte size pos) x)
+		      (logand (1- (ash 1 size))
+			      (ash x (- pos))))
+	  collect (list x pos size)))
+  nil)
+
+(deftest ldb.3
+  (loop for i of-type fixnum from -1000 to 1000
+	always (eql (ldb (byte 0 0) i) 0))
+  t)
+
+(deftest ldb.order.1
+  (let ((i 0) a b c d)
+    (values
+     (ldb (progn (setf a (incf i))
+		 (byte (progn (setf b (incf i)) 3)
+		       (progn (setf c (incf i)) 1)))
+	  (progn (setf d (incf i)) -1))
+     i a b c d))
+  7 4 1 2 3 4)
+
+;;; ldb on places
+
+(deftest ldb.place.1
+  (let ((x 0))
+    (values
+     (setf (ldb (byte 4 1) x) -1)
+     x))
+  -1 30)
+
+(deftest ldb.place.2
+  (loop for pos from 0 to 100
+	always
+	(loop for size from 0 to 100
+	      always
+	      (let ((x 0))
+		(and (eql (setf (ldb (byte size pos) x) -1) -1)
+		     (eql x (ash (1- (ash 1 size)) pos))))))
+  t)
+
+(deftest ldb.place.order.1
+  (let ((i 0) a b c d e f (x (copy-seq #(63))))
+    (values
+     (setf (ldb (progn (setf a (incf i))
+		       (byte (progn (setf b (incf i)) 3)
+			     (progn (setf c (incf i)) 1)))
+		(aref (progn (setf d (incf i)) x)
+		      (progn (setf e (incf i)) 0)))
+	   (progn (setf f (incf i)) 0))
+     x
+     i a b c d e f))
+  0 #(49) 6 1 2 3 4 5 6)
diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp
index f90f07e8..06ef3cc3 100644
--- a/ansi-tests/load-numbers.lsp
+++ b/ansi-tests/load-numbers.lsp
@@ -6,6 +6,8 @@
 (in-package :cl-test)
 
 (compile-and-load "numbers-aux.lsp")
+(compile-and-load "random-aux.lsp")
+
 (load "number-comparison.lsp")
 (load "max.lsp")
 (load "min.lsp")
@@ -74,6 +76,12 @@
 (load "logxor.lsp")
 (load "logbitp.lsp")
 
+(load "byte.lsp")
+(load "deposit-field.lsp")
+(load "dpb.lsp")
+(load "ldb.lsp")
+(load "mask-field.lsp")
+
 (load "rational.lsp")
 (load "rationalize.lsp")
 
diff --git a/ansi-tests/mask-field.lsp b/ansi-tests/mask-field.lsp
new file mode 100644
index 00000000..237f53cd
--- /dev/null
+++ b/ansi-tests/mask-field.lsp
@@ -0,0 +1,91 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Thu Sep 11 21:27:13 2003
+;;;; Contains: Tests of MASK-FIELD
+
+(in-package :cl-test)
+
+(in-package :cl-test)
+
+(deftest mask-field.error.1
+  (classify-error (mask-field))
+  program-error)
+
+(deftest mask-field.error.2
+  (classify-error (mask-field (byte 1 1)))
+  program-error)
+
+(deftest mask-field.error.3
+  (classify-error (mask-field (byte 1 1) -1 0))
+  program-error)
+
+(deftest mask-field.1
+  (loop for x = (random-fixnum)
+	for pos = (random 30)
+	for size = (random 30)
+	repeat 10000
+	unless (eql (mask-field (byte size pos) x)
+		    (logand (ash (1- (ash 1 size)) pos) x))
+	collect (list x pos size))
+  nil)
+
+
+(deftest mask-field.2
+  (let ((bound (ash 1 300)))
+    (loop for x = (random-from-interval bound)
+	  for pos = (random 300)
+	  for size = (random 300)
+	  repeat 1000
+	  unless (eql (mask-field (byte size pos) x)
+		      (logand (ash (1- (ash 1 size)) pos) x))
+	  collect (list x pos size)))
+  nil)
+
+(deftest mask-field.3
+  (loop for i of-type fixnum from -1000 to 1000
+	always (eql (mask-field (byte 0 0) i) 0))
+  t)
+
+(deftest mask-field.order.1
+  (let ((i 0) a b c d)
+    (values
+     (mask-field (progn (setf a (incf i))
+		 (byte (progn (setf b (incf i)) 3)
+		       (progn (setf c (incf i)) 1)))
+	  (progn (setf d (incf i)) -1))
+     i a b c d))
+  14 4 1 2 3 4)
+
+;;; mask-field on places
+
+(deftest mask-field.place.1
+  (let ((x 0))
+    (values
+     (setf (mask-field (byte 4 1) x) -1)
+     x))
+  -1 30)
+
+(deftest mask-field.place.2
+  (loop for pos from 0 to 100
+	always
+	(loop for size from 0 to 100
+	      always
+	      (let ((x 0)
+		    (field (ash 1 pos)))
+		(and (eql (setf (mask-field (byte size pos) x) field) field)
+		     (if (> size 0) (eql x field) (eql x 0))
+		     ))))
+  t)
+
+(deftest mask-field.place.order.1
+  (let ((i 0) a b c d e f (x (copy-seq #(63))))
+    (values
+     (setf (mask-field (progn (setf a (incf i))
+		       (byte (progn (setf b (incf i)) 3)
+			     (progn (setf c (incf i)) 1)))
+		(aref (progn (setf d (incf i)) x)
+		      (progn (setf e (incf i)) 0)))
+	   (progn (setf f (incf i)) (lognot 14)))
+     x
+     i a b c d e f))
+  -15 #(49) 6 1 2 3 4 5 6)
-- 
GitLab