ldb.lsp 1.91 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
81
82
83
84
85
86
87
88
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)