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

« back to all changes in this revision

Viewing changes to ansi-tests/logbitp.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:
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Tue Sep  9 07:02:00 2003
 
4
;;;; Contains: Tests of LOGBITP
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "numbers-aux.lsp")
 
9
 
 
10
;;; Error tests
 
11
 
 
12
(deftest logbitp.error.1
 
13
  (signals-error (logbitp) program-error)
 
14
  t)
 
15
 
 
16
(deftest logbitp.error.2
 
17
  (signals-error (logbitp 0) program-error)
 
18
  t)
 
19
 
 
20
(deftest logbitp.error.3
 
21
  (signals-error (logbitp 0 0 0) program-error)
 
22
  t)
 
23
 
 
24
(deftest logbitp.error.4
 
25
  (signals-error (logbitp -1 0) type-error)
 
26
  t)
 
27
 
 
28
(deftest logbitp.error.5
 
29
  (loop for x in *mini-universe*
 
30
        unless (or (integerp x)
 
31
                   (eval `(signals-error (logbitp 0 ',x) type-error)))
 
32
        collect x)
 
33
  nil)
 
34
 
 
35
;;; Non-error tests
 
36
 
 
37
(deftest logbitp.1
 
38
  (loop for x in *integers*
 
39
        unless (if (logbitp 0 x) (oddp x) (evenp x))
 
40
        collect x)
 
41
  nil)
 
42
 
 
43
(deftest logbitp.2
 
44
  (loop for len from 0 to 300
 
45
        for i = (ash 1 len)
 
46
        always (and (logbitp len i)
 
47
                    (loop for j from 0 to 300
 
48
                          always (or (eql j len)
 
49
                                     (not (logbitp j i))))))
 
50
  t)
 
51
 
 
52
(deftest logbitp.3
 
53
  (logbitp most-positive-fixnum 0)
 
54
  nil)
 
55
        
 
56
(deftest logbitp.4
 
57
  (notnot-mv (logbitp most-positive-fixnum -1))
 
58
  t)
 
59
 
 
60
(deftest logbitp.5
 
61
  (logbitp (1+ most-positive-fixnum) 0)
 
62
  nil)
 
63
        
 
64
(deftest logbitp.6
 
65
  (notnot-mv (logbitp (1+ most-positive-fixnum) -1))
 
66
  t)
 
67
 
 
68
(deftest logbitp.7
 
69
  (loop for len = (random 100)
 
70
        for i = (random-from-interval (ash 1 len))
 
71
        for k = (random (1+ len))
 
72
        repeat 1000
 
73
        unless (if (ldb-test (byte 1 k) i)
 
74
                   (logbitp k i)
 
75
                 (not (logbitp k i)))
 
76
        collect (list i k))
 
77
  nil)
 
78
 
 
79
(deftest logbitp.8
 
80
  (loop for k from 1 to 1000
 
81
        always (logbitp k -1))
 
82
  t)
 
83
 
 
84
(deftest logbitp.order.1
 
85
  (let ((i 0) a b)
 
86
    (values
 
87
     (logbitp (progn (setf a (incf i)) 2)
 
88
              (progn (setf b (incf i)) #b111010))
 
89
     i a b))
 
90
  nil 2 1 2)
 
91
 
 
92
 
 
93
 
 
94
 
 
95
        
 
96