boole.lsp 4.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Sep  8 20:21:19 2003
;;;; Contains: Tests of BOOLE and associated constants

(in-package :cl-test)

(compile-and-load "numbers-aux.lsp")

(defparameter *boole-val-names*
  '(boole-1 boole-2 boole-and boole-andc1 boole-andc2
    boole-c1 boole-c2 boole-clr boole-eqv boole-ior
    boole-nand boole-nor boole-orc1 boole-orc2 boole-set boole-xor))

(defparameter *boole-vals*
  (list boole-1 boole-2 boole-and boole-andc1 boole-andc2
sds's avatar
sds committed
17 18
        boole-c1 boole-c2 boole-clr boole-eqv boole-ior boole-nand
        boole-nor boole-orc1 boole-orc2 boole-set boole-xor))
19 20 21

(defparameter *boole-fns*
  (list #'(lambda (x y) (declare (ignore y)) x)
sds's avatar
sds committed
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
        #'(lambda (x y) (declare (ignore x)) y)
        #'logand
        #'logandc1
        #'logandc2
        #'(lambda (x y) (declare (ignore y)) (lognot x))
        #'(lambda (x y) (declare (ignore x)) (lognot y))
        (constantly 0)
        #'logeqv
        #'logior
        #'lognand
        #'lognor
        #'logorc1
        #'logorc2
        (constantly -1)
        #'logxor))
37 38

(deftest boole.error.1
39 40
  (signals-error (boole) program-error)
  t)
41 42

(deftest boole.error.2
43 44
  (signals-error (boole boole-1) program-error)
  t)
45 46

(deftest boole.error.3
47 48
  (signals-error (boole boole-1 1) program-error)
  t)
49 50

(deftest boole.error.4
51 52
  (signals-error (boole boole-1 1 2 nil) program-error)
  t)
53 54 55

(deftest boole.error.5
  (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 60

(deftest boole.error.6
  (loop for n in *boole-val-names*
sds's avatar
sds committed
61 62
        unless (eval `(signals-type-error x nil (boole ,n nil 1)))
        collect n)
63 64 65 66
  nil)

(deftest boole.error.7
  (loop for n in *boole-val-names*
sds's avatar
sds committed
67 68
        unless (eval `(signals-type-error x nil (boole ,n 1 nil)))
        collect n)
69 70 71 72
  nil)

(deftest boole.1
  (loop for v in *boole-vals*
sds's avatar
sds committed
73 74 75 76 77 78 79 80 81 82 83
        for fn of-type function in *boole-fns*
        for n in *boole-val-names*
        nconc
        (loop for x = (random-fixnum)
              for y = (random-fixnum)
              for result1 = (funcall (the function fn) x y)
              for vals = (multiple-value-list (boole v x y))
              for result2 = (car vals)
              repeat 100
              unless (and (= (length vals) 1) (eql result1 result2))
              collect (list n x y result1 result2)))
84 85 86 87
  nil)

(deftest boole.2
  (loop for v in *boole-vals*
sds's avatar
sds committed
88 89 90 91 92 93 94 95 96 97 98
        for fn of-type function in *boole-fns*
        for n in *boole-val-names*
        nconc
        (loop for x = (random-from-interval 1000000000000000)
              for y = (random-from-interval 1000000000000000)
              for result1 = (funcall (the function fn) x y)
              for vals = (multiple-value-list (boole v x y))
              for result2 = (car vals)
              repeat 100
              unless (and (= (length vals) 1) (eql result1 result2))
              collect (list n x y result1 result2)))
99 100 101 102
  nil)

(deftest boole.3
  (loop for n in *boole-val-names*
sds's avatar
sds committed
103 104 105 106 107 108 109 110 111 112 113 114
        for fn of-type function in *boole-fns*
        for fn2 = (compile nil `(lambda (x y) (declare (type fixnum x y))
                                  (boole ,n x y)))
        nconc
        (loop for x = (random-fixnum)
              for y = (random-fixnum)
              for result1 = (funcall (the function fn) x y)
              for vals = (multiple-value-list (funcall fn2 x y))
              for result2 = (car vals)
              repeat 100
              unless (and (= (length vals) 1) (eql result1 result2))
              collect (list n x y result1 result2)))
115 116
  nil)

117 118
(deftest boole.4
  (macrolet ((%m (z) z))
sds's avatar
sds committed
119 120 121
            (values (boole (expand-in-current-env (%m boole-and)) #b11001100 #b01011010)
                    (boole boole-and (expand-in-current-env (%m #b11001100)) #b01011010)
                    (boole boole-and #b11001100 (expand-in-current-env (%m #b01011010)))))
122 123 124 125
  #b01001000
  #b01001000
  #b01001000)

126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
;;; Order of evaluation
(deftest boole.order.1
  (let ((i 0) a b c)
    (values
     (boole
      (progn (setf a (incf i)) boole-and)
      (progn (setf b (incf i)) #b1101)
      (progn (setf c (incf i)) #b11001))
     i a b c))
  #b1001 3 1 2 3)

;;; Constants are constants

(deftest boole.constants.1
  (eqlt (length *boole-vals*)
sds's avatar
sds committed
141
        (length (remove-duplicates *boole-vals*)))
142 143 144 145 146 147 148 149 150
  t)

(deftest boole.constants.2
  (remove-if #'constantp *boole-val-names*)
  nil)

(deftest boole.constants.3
  (remove-if #'boundp *boole-val-names*)
  nil)