← Back to branch summary

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

« back to all changes in this revision

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