source: trunk/source/tests/ansi-tests/boole.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.0 KB
Line 
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)
Note: See TracBrowser for help on using the repository browser.