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