Commit 2fbeb6dd authored by pfdietz's avatar pfdietz

Initial checkin for tests of BYTE, BYTE-SIZE, BYTE-POSITION, DEPOSIT-FIELD, DPB, LDB, MASK-FIELD

parent 7e4f7bc5
;-*- 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)
;-*- 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)
;-*- 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)
;-*- 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)
......@@ -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")
......
;-*- 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)
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