;-*- 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 boole-c1 boole-c2 boole-clr boole-eqv boole-ior boole-nand boole-nor boole-orc1 boole-orc2 boole-set boole-xor)) (defparameter *boole-fns* (list #'(lambda (x y) (declare (ignore y)) x) #'(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)) (deftest boole.error.1 (classify-error (boole)) program-error) (deftest boole.error.2 (classify-error (boole boole-1)) program-error) (deftest boole.error.3 (classify-error (boole boole-1 1)) program-error) (deftest boole.error.4 (classify-error (boole boole-1 1 2 nil)) program-error) (deftest boole.error.5 (let ((bad (loop for i from 1 until (not (member i *boole-vals*))))) (eval `(classify-error (boole ,bad 1 1)))) type-error) (deftest boole.error.6 (loop for n in *boole-val-names* unless (eq (eval `(classify-error (boole ,n nil 1))) 'type-error) collect n) nil) (deftest boole.error.7 (loop for n in *boole-val-names* unless (eq (eval `(classify-error (boole ,n 1 nil))) 'type-error) collect n) nil) (deftest boole.1 (loop for v in *boole-vals* 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))) nil) (deftest boole.2 (loop for v in *boole-vals* 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))) nil) (deftest boole.3 (loop for n in *boole-val-names* 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))) nil) ;;; 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*) (length (remove-duplicates *boole-vals*))) t) (deftest boole.constants.2 (remove-if #'constantp *boole-val-names*) nil) (deftest boole.constants.3 (remove-if #'boundp *boole-val-names*) nil)