deposit-field.lsp 2.15 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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)