1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Mon Sep 8 20:21:19 2003 |
---|
4 | ;;;; Contains: Tests of BOOLE and associated constants |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (compile-and-load "numbers-aux.lsp") |
---|
9 | |
---|
10 | (defparameter *boole-val-names* |
---|
11 | '(boole-1 boole-2 boole-and boole-andc1 boole-andc2 |
---|
12 | boole-c1 boole-c2 boole-clr boole-eqv boole-ior |
---|
13 | boole-nand boole-nor boole-orc1 boole-orc2 boole-set boole-xor)) |
---|
14 | |
---|
15 | (defparameter *boole-vals* |
---|
16 | (list boole-1 boole-2 boole-and boole-andc1 boole-andc2 |
---|
17 | boole-c1 boole-c2 boole-clr boole-eqv boole-ior boole-nand |
---|
18 | boole-nor boole-orc1 boole-orc2 boole-set boole-xor)) |
---|
19 | |
---|
20 | (defparameter *boole-fns* |
---|
21 | (list #'(lambda (x y) (declare (ignore y)) x) |
---|
22 | #'(lambda (x y) (declare (ignore x)) y) |
---|
23 | #'logand |
---|
24 | #'logandc1 |
---|
25 | #'logandc2 |
---|
26 | #'(lambda (x y) (declare (ignore y)) (lognot x)) |
---|
27 | #'(lambda (x y) (declare (ignore x)) (lognot y)) |
---|
28 | (constantly 0) |
---|
29 | #'logeqv |
---|
30 | #'logior |
---|
31 | #'lognand |
---|
32 | #'lognor |
---|
33 | #'logorc1 |
---|
34 | #'logorc2 |
---|
35 | (constantly -1) |
---|
36 | #'logxor)) |
---|
37 | |
---|
38 | (deftest boole.error.1 |
---|
39 | (signals-error (boole) program-error) |
---|
40 | t) |
---|
41 | |
---|
42 | (deftest boole.error.2 |
---|
43 | (signals-error (boole boole-1) program-error) |
---|
44 | t) |
---|
45 | |
---|
46 | (deftest boole.error.3 |
---|
47 | (signals-error (boole boole-1 1) program-error) |
---|
48 | t) |
---|
49 | |
---|
50 | (deftest boole.error.4 |
---|
51 | (signals-error (boole boole-1 1 2 nil) program-error) |
---|
52 | t) |
---|
53 | |
---|
54 | (deftest boole.error.5 |
---|
55 | (let ((bad (loop for i from 1 until (not (member i *boole-vals*))))) |
---|
56 | (eval `(signals-type-error x ',bad (boole x 1 1)))) |
---|
57 | t) |
---|
58 | |
---|
59 | (deftest boole.error.6 |
---|
60 | (loop for n in *boole-val-names* |
---|
61 | unless (eval `(signals-type-error x nil (boole ,n nil 1))) |
---|
62 | collect n) |
---|
63 | nil) |
---|
64 | |
---|
65 | (deftest boole.error.7 |
---|
66 | (loop for n in *boole-val-names* |
---|
67 | unless (eval `(signals-type-error x nil (boole ,n 1 nil))) |
---|
68 | collect n) |
---|
69 | nil) |
---|
70 | |
---|
71 | (deftest boole.1 |
---|
72 | (loop for v in *boole-vals* |
---|
73 | for fn of-type function in *boole-fns* |
---|
74 | for n in *boole-val-names* |
---|
75 | nconc |
---|
76 | (loop for x = (random-fixnum) |
---|
77 | for y = (random-fixnum) |
---|
78 | for result1 = (funcall (the function fn) x y) |
---|
79 | for vals = (multiple-value-list (boole v x y)) |
---|
80 | for result2 = (car vals) |
---|
81 | repeat 100 |
---|
82 | unless (and (= (length vals) 1) (eql result1 result2)) |
---|
83 | collect (list n x y result1 result2))) |
---|
84 | nil) |
---|
85 | |
---|
86 | (deftest boole.2 |
---|
87 | (loop for v in *boole-vals* |
---|
88 | for fn of-type function in *boole-fns* |
---|
89 | for n in *boole-val-names* |
---|
90 | nconc |
---|
91 | (loop for x = (random-from-interval 1000000000000000) |
---|
92 | for y = (random-from-interval 1000000000000000) |
---|
93 | for result1 = (funcall (the function fn) x y) |
---|
94 | for vals = (multiple-value-list (boole v x y)) |
---|
95 | for result2 = (car vals) |
---|
96 | repeat 100 |
---|
97 | unless (and (= (length vals) 1) (eql result1 result2)) |
---|
98 | collect (list n x y result1 result2))) |
---|
99 | nil) |
---|
100 | |
---|
101 | (deftest boole.3 |
---|
102 | (loop for n in *boole-val-names* |
---|
103 | for fn of-type function in *boole-fns* |
---|
104 | for fn2 = (compile nil `(lambda (x y) (declare (type fixnum x y)) |
---|
105 | (boole ,n x y))) |
---|
106 | nconc |
---|
107 | (loop for x = (random-fixnum) |
---|
108 | for y = (random-fixnum) |
---|
109 | for result1 = (funcall (the function fn) x y) |
---|
110 | for vals = (multiple-value-list (funcall fn2 x y)) |
---|
111 | for result2 = (car vals) |
---|
112 | repeat 100 |
---|
113 | unless (and (= (length vals) 1) (eql result1 result2)) |
---|
114 | collect (list n x y result1 result2))) |
---|
115 | nil) |
---|
116 | |
---|
117 | (deftest boole.4 |
---|
118 | (macrolet ((%m (z) z)) |
---|
119 | (values (boole (expand-in-current-env (%m boole-and)) #b11001100 #b01011010) |
---|
120 | (boole boole-and (expand-in-current-env (%m #b11001100)) #b01011010) |
---|
121 | (boole boole-and #b11001100 (expand-in-current-env (%m #b01011010))))) |
---|
122 | #b01001000 |
---|
123 | #b01001000 |
---|
124 | #b01001000) |
---|
125 | |
---|
126 | ;;; Order of evaluation |
---|
127 | (deftest boole.order.1 |
---|
128 | (let ((i 0) a b c) |
---|
129 | (values |
---|
130 | (boole |
---|
131 | (progn (setf a (incf i)) boole-and) |
---|
132 | (progn (setf b (incf i)) #b1101) |
---|
133 | (progn (setf c (incf i)) #b11001)) |
---|
134 | i a b c)) |
---|
135 | #b1001 3 1 2 3) |
---|
136 | |
---|
137 | ;;; Constants are constants |
---|
138 | |
---|
139 | (deftest boole.constants.1 |
---|
140 | (eqlt (length *boole-vals*) |
---|
141 | (length (remove-duplicates *boole-vals*))) |
---|
142 | t) |
---|
143 | |
---|
144 | (deftest boole.constants.2 |
---|
145 | (remove-if #'constantp *boole-val-names*) |
---|
146 | nil) |
---|
147 | |
---|
148 | (deftest boole.constants.3 |
---|
149 | (remove-if #'boundp *boole-val-names*) |
---|
150 | nil) |
---|