← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/boole.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/boole.lsp
 
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-error (boole ,bad 1 1) type-error)))
 
57
  t)
 
58
 
 
59
(deftest boole.error.6
 
60
  (loop for n in *boole-val-names*
 
61
        unless (eval `(signals-error (boole ,n nil 1) type-error))
 
62
        collect n)
 
63
  nil)
 
64
 
 
65
(deftest boole.error.7
 
66
  (loop for n in *boole-val-names*
 
67
        unless (eval `(signals-error (boole ,n 1 nil) type-error))
 
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
;;; Order of evaluation
 
118
(deftest boole.order.1
 
119
  (let ((i 0) a b c)
 
120
    (values
 
121
     (boole
 
122
      (progn (setf a (incf i)) boole-and)
 
123
      (progn (setf b (incf i)) #b1101)
 
124
      (progn (setf c (incf i)) #b11001))
 
125
     i a b c))
 
126
  #b1001 3 1 2 3)
 
127
 
 
128
;;; Constants are constants
 
129
 
 
130
(deftest boole.constants.1
 
131
  (eqlt (length *boole-vals*)
 
132
        (length (remove-duplicates *boole-vals*)))
 
133
  t)
 
134
 
 
135
(deftest boole.constants.2
 
136
  (remove-if #'constantp *boole-val-names*)
 
137
  nil)
 
138
 
 
139
(deftest boole.constants.3
 
140
  (remove-if #'boundp *boole-val-names*)
 
141
  nil)