← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/logxor.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/logxor.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Tue Sep  9 06:30:57 2003
 
4
;;;; Contains: Tests of LOGXOR
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "numbers-aux.lsp")
 
9
 
 
10
;;; Error tests
 
11
 
 
12
(deftest logxor.error.1
 
13
  (loop for x in *mini-universe*
 
14
        unless (or (integerp x)
 
15
                   (eval `(signals-error (logxor ',x) type-error)))
 
16
        collect x)
 
17
  nil)
 
18
 
 
19
(deftest logxor.error.2
 
20
  (loop for x in *mini-universe*
 
21
        unless (or (integerp x)
 
22
                   (eval `(signals-error (logxor 0 ',x) type-error)))
 
23
        collect x)
 
24
  nil)
 
25
 
 
26
 
 
27
;;; Non-error tests
 
28
 
 
29
(deftest logxor.1
 
30
  (logxor)
 
31
  0)
 
32
 
 
33
(deftest logxor.2
 
34
  (logxor 1231)
 
35
  1231)
 
36
 
 
37
(deftest logxor.3
 
38
  (logxor -198)
 
39
  -198)
 
40
 
 
41
(deftest logxor.4
 
42
  (loop for x in *integers*
 
43
        always (eql x (logxor x)))
 
44
  t)
 
45
 
 
46
(deftest logxor.5
 
47
  (loop for x in *integers*
 
48
        always (and (eql -1 (logxor x (lognot x)))
 
49
                    (eql 0 (logxor x x))
 
50
                    (eql x (logxor x x x))))
 
51
  t)
 
52
 
 
53
(deftest logxor.6
 
54
  (loop for x = (random-fixnum)
 
55
        for xc = (lognot x)
 
56
        repeat 1000
 
57
        unless (eql -1 (logxor x xc))
 
58
        collect x)
 
59
  nil)
 
60
 
 
61
(deftest logxor.7
 
62
  (loop for x = (random-from-interval (ash 1 (random 200)))
 
63
        for y = (random-from-interval (ash 1 (random 200)))
 
64
        for z = (logxor x y)
 
65
        repeat 1000
 
66
        unless (and (if (or (and (< x 0) (>= y 0))
 
67
                            (and (>= x 0) (< y 0)))
 
68
                        (< z 0)
 
69
                      (>= z 0))
 
70
                    (loop for i from 1 to 210
 
71
                          always (if (or (and (logbitp i x)
 
72
                                              (not (logbitp i y)))
 
73
                                         (and (not (logbitp i x))
 
74
                                              (logbitp i y)))
 
75
                                     (logbitp i z)
 
76
                                   (not (logbitp i z)))))
 
77
        collect (list x y z))
 
78
  nil)
 
79
 
 
80
(deftest logxor.8
 
81
  (loop for i from 1 to (min 256 (1- call-arguments-limit))
 
82
        for args = (nconc (make-list (1- i) :initial-element 0)
 
83
                          (list 7131))
 
84
        always (eql (apply #'logxor args) 7131))
 
85
  t)
 
86
 
 
87
(deftest logxor.order.1
 
88
  (let ((i 0) a b)
 
89
    (values
 
90
     (logxor (progn (setf a (incf i)) #b11011)
 
91
             (progn (setf b (incf i)) #b10110))
 
92
     i a b))
 
93
  #b1101 2 1 2)
 
94
  
 
95
 
 
96
(deftest logxor.order.2
 
97
  (let ((i 0) a b c)
 
98
    (values
 
99
     (logxor (progn (setf a (incf i))  #b11011)
 
100
             (progn (setf b (incf i))  #b10110)
 
101
             (progn (setf c (incf i)) #b110101))
 
102
     i a b c))
 
103
  #b111000 3 1 2 3)
 
104
 
 
105