enum.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
enum.lisp (6288B)
---
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; enum.lisp --- Tests on C enums.
4 ;;;
5 ;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira(@)common-lisp.net>
6 ;;;
7 ;;; Permission is hereby granted, free of charge, to any person
8 ;;; obtaining a copy of this software and associated documentation
9 ;;; files (the "Software"), to deal in the Software without
10 ;;; restriction, including without limitation the rights to use, copy,
11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
12 ;;; of the Software, and to permit persons to whom the Software is
13 ;;; furnished to do so, subject to the following conditions:
14 ;;;
15 ;;; The above copyright notice and this permission notice shall be
16 ;;; included in all copies or substantial portions of the Software.
17 ;;;
18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
21 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25 ;;; DEALINGS IN THE SOFTWARE.
26 ;;;
27
28 (in-package #:cffi-tests)
29
30 (defctype numeros-base-type :int)
31
32 (defcenum (numeros numeros-base-type)
33 (:one 1)
34 :two
35 :three
36 :four
37 (:forty-one 41)
38 :forty-two)
39
40 (defcfun "check_enums" :int
41 (%one numeros)
42 (%two numeros)
43 (%three numeros)
44 (%four numeros)
45 (%forty-one numeros)
46 (%forty-two numeros))
47
48 (deftest enum.1
49 (check-enums :one :two :three 4 :forty-one :forty-two)
50 1)
51
52 (defcenum another-boolean :false :true)
53 (defcfun "return_enum" another-boolean (x :uint))
54
55 (deftest enum.2
56 (and (eq :false (return-enum 0))
57 (eq :true (return-enum 1)))
58 t)
59
60 (defctype yet-another-boolean another-boolean)
61 (defcfun ("return_enum" return-enum2) yet-another-boolean
62 (x yet-another-boolean))
63
64 (deftest enum.3
65 (and (eq :false (return-enum2 :false))
66 (eq :true (return-enum2 :true)))
67 t)
68
69 (defctype numeros-typedef numeros)
70
71 (deftest enum.typedef.1
72 (eq (foreign-enum-keyword 'numeros-typedef 1)
73 (foreign-enum-keyword 'numeros 1))
74 t)
75
76 (deftest enum.typedef.2
77 (eql (foreign-enum-value 'numeros-typedef :four)
78 (foreign-enum-value 'numeros :four))
79 t)
80
81 (defcenum enum-size.int
82 (:one 1)
83 (enum-size-int #.(1- (expt 2 (1- (* (foreign-type-size :unsigned-int) 8)))))
84 (enum-size-negative-int #.(- (1- (expt 2 (1- (* (foreign-type-size :unsigned-int) 8))))))
85 (:two 2))
86
87 (defcenum enum-size.uint
88 (:one 1)
89 (enum-size-uint #.(1- (expt 2 (* (foreign-type-size :unsigned-int) 8))))
90 (:two 2))
91
92 (deftest enum.size
93 (mapcar (alexandria:compose 'cffi::unparse-type
94 'cffi::actual-type
95 'cffi::parse-type)
96 (list 'enum-size.int
97 'enum-size.uint))
98 ;; The C standard only has weak constraints on the size of integer types, so
99 ;; we cannot really test more than one type in a platform independent way due
100 ;; to the possible overlaps.
101 (:int
102 :unsigned-int))
103
104 (deftest enum.size.members
105 (mapcar (alexandria:conjoin 'boundp 'constantp)
106 '(enum-size-int enum-size-negative-int enum-size-uint))
107 (t t t))
108
109 (deftest enum.size.error-when-too-large
110 (expecting-error
111 (eval '(defcenum enum-size-too-large
112 (:too-long #.(expt 2 129)))))
113 :error)
114
115 ;; There are some projects that use non-integer base type. It's not in
116 ;; adherence with the C standard, but we also don't lose much by
117 ;; allowing it.
118 (defcenum (enum.double :double)
119 (:one 1)
120 (:two 2d0)
121 (:three 3.42)
122 :four)
123
124 (deftest enum.double
125 (values-list
126 (mapcar (alexandria:curry 'foreign-enum-value 'enum.double)
127 '(:one :two :three :four)))
128 1
129 2.0d0
130 3.42
131 4.42)
132
133 ;;;# Bitfield tests
134
135 ;;; Regression test: defbitfield was misbehaving when the first value
136 ;;; was provided.
137 (deftest bitfield.1
138 (eval '(defbitfield (bf1 :long)
139 (:foo 0)))
140 bf1)
141
142 (defbitfield bf2
143 one
144 two
145 four
146 eight
147 sixteen
148 (bf2.outlier 42)
149 thirty-two
150 sixty-four)
151
152 (deftest bitfield.2
153 (mapcar (lambda (symbol)
154 (foreign-bitfield-value 'bf2 (list symbol)))
155 '(one two four eight sixteen thirty-two sixty-four))
156 (1 2 4 8 16 32 64))
157
158 (deftest bitfield.2.outlier
159 (mapcar (lambda (symbol)
160 (foreign-bitfield-value 'bf2 (list symbol)))
161 '(one two four eight sixteen thirty-two sixty-four))
162 (1 2 4 8 16 32 64))
163
164 (defbitfield (bf3 :int)
165 (three 3)
166 one
167 (seven 7)
168 two
169 (eight 8)
170 sixteen)
171
172 ;;; Non-single-bit numbers must not influence the progression of
173 ;;; implicit values. Single bits larger than any before *must*
174 ;;; influence said progression.
175 (deftest bitfield.3
176 (mapcar (lambda (symbol)
177 (foreign-bitfield-value 'bf3 (list symbol)))
178 '(one two sixteen))
179 (1 2 16))
180
181 (defbitfield bf4
182 ;; zero will be a simple enum member because it's not a valid mask
183 (zero 0)
184 one
185 two
186 four
187 (three 3)
188 (sixteen 16))
189
190 ;;; Yet another edge case with the 0...
191 (deftest bitfield.4
192 ;; These should macroexpand to the literals in Slime
193 ;; due to the compiler macros. Same below.
194 (values (foreign-bitfield-value 'bf4 ())
195 (foreign-bitfield-value 'bf4 'one)
196 (foreign-bitfield-value 'bf4 '(one two))
197 (foreign-bitfield-value 'bf4 '(three)) ; or should it signal an error?
198 (foreign-bitfield-value 'bf4 '(sixteen)))
199 0
200 1
201 3
202 3
203 16)
204
205 (deftest bitfield.4b
206 (values (foreign-bitfield-symbols 'bf4 0)
207 (foreign-bitfield-symbols 'bf4 1)
208 (foreign-bitfield-symbols 'bf4 3)
209 (foreign-bitfield-symbols 'bf4 8)
210 (foreign-bitfield-symbols 'bf4 16))
211 nil
212 (one)
213 (one two)
214 nil
215 (sixteen))
216
217 (deftest bitfield.translators
218 (with-foreign-object (bf 'bf4 2)
219 (setf (mem-aref bf 'bf4 0) 1)
220 (setf (mem-aref bf 'bf4 1) 3)
221 (values (mem-aref bf 'bf4 0)
222 (mem-aref bf 'bf4 1)))
223 (one)
224 (one two))
225
226 #+nil
227 (deftest bitfield.base-type-error
228 (expecting-error
229 (eval '(defbitfield (bf1 :float)
230 (:foo 0))))
231 :error)