source: trunk/source/tests/ansi-tests/bit.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jan 26 13:22:59 2003
4;;;; Contains: Tests for accessor BIT
5
6(in-package :cl-test)
7
8(deftest bit.1
9  (bit #*0010 2)
10  1)
11
12(deftest bit.2
13  (let ((a #*00000000))
14    (loop for i from 0 below (length a)
15          collect (let ((b (copy-seq a)))
16                    (setf (bit b i) 1)
17                    b)))
18  (#*10000000
19   #*01000000
20   #*00100000
21   #*00010000
22   #*00001000
23   #*00000100
24   #*00000010
25   #*00000001))
26
27(deftest bit.3
28  (let ((a #*11111111))
29    (loop for i from 0 below (length a)
30          collect (let ((b (copy-seq a)))
31                    (setf (bit b i) 0)
32                    b)))
33  (#*01111111
34   #*10111111
35   #*11011111
36   #*11101111
37   #*11110111
38   #*11111011
39   #*11111101
40   #*11111110))
41
42(deftest bit.4
43  (let ((a (make-array nil :element-type 'bit :initial-element 0)))
44    (values
45     (aref a)
46     (bit a)
47     (setf (bit a) 1)
48     (aref a)
49     (bit a)))
50  0 0 1 1 1)
51
52(deftest bit.5
53  (let ((a (make-array '(1 1) :element-type 'bit :initial-element 0)))
54    (values
55     (aref a 0 0)
56     (bit a 0 0)
57     (setf (bit a 0 0) 1)
58     (aref a 0 0)
59     (bit a 0 0)))
60  0 0 1 1 1)
61
62(deftest bit.6
63  (let ((a (make-array '(10 10) :element-type 'bit :initial-element 0)))
64    (values
65     (aref a 5 5)
66     (bit a 5 5)
67     (setf (bit a 5 5) 1)
68     (aref a 5 5)
69     (bit a 5 5)))
70  0 0 1 1 1)
71
72;;; Check that the fill pointer is ignored
73
74(deftest bit.7
75  (let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 1 1 1 0 0)
76                       :element-type 'bit
77                       :fill-pointer 5)))
78    (values
79     (coerce a 'list)
80     (loop for i from 0 below 10 collect (bit a i))
81     (loop for i from 0 below 10
82           collect (setf (bit a i) (- 1 (bit a i))))
83     (coerce a 'list)
84     (loop for i from 0 below 10 collect (bit a i))
85     (fill-pointer a)))
86  (0 1 1 0 0)
87  (0 1 1 0 0 1 1 1 0 0)
88  (1 0 0 1 1 0 0 0 1 1)
89  (1 0 0 1 1)
90  (1 0 0 1 1 0 0 0 1 1)
91  5)
92
93;;; Check that adjustability is not relevant
94
95(deftest bit.8
96  (let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 1 1 1 0 0)
97                       :element-type 'bit
98                       :adjustable t)))
99    (values
100     (coerce a 'list)
101     (loop for i from 0 below 10 collect (bit a i))
102     (loop for i from 0 below 10
103           collect (setf (bit a i) (- 1 (bit a i))))
104     (coerce a 'list)
105     (loop for i from 0 below 10 collect (bit a i))))
106  (0 1 1 0 0 1 1 1 0 0)
107  (0 1 1 0 0 1 1 1 0 0)
108  (1 0 0 1 1 0 0 0 1 1)
109  (1 0 0 1 1 0 0 0 1 1)
110  (1 0 0 1 1 0 0 0 1 1))
111
112;;; Order of evaluation tests
113
114(deftest bit.order.1
115  (let ((x 0) y z
116        (b (copy-seq #*01010)))
117    (values
118     (bit (progn (setf y (incf x)) b)
119          (progn (setf z (incf x)) 1))
120     x y z))
121  1 2 1 2)
122
123(deftest bit.order.2
124  (let ((x 0) y z w
125        (b (copy-seq #*01010)))
126    (values
127     (setf (bit (progn (setf y (incf x)) b)
128                (progn (setf z (incf x)) 1))
129           (progn (setf w (incf x)) 0))
130     b
131     x y z w))
132  0 #*00010 3 1 2 3)
133
134(deftest bit.error.1
135  (signals-error (bit) program-error)
136  t)
Note: See TracBrowser for help on using the repository browser.