Introduction
Introduction Statistics Contact Development Disclaimer Help
tenum.lisp - clic - Clic is an command line interactive client for gopher writt…
git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
Log
Files
Refs
Tags
LICENSE
---
tenum.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) …
84 (enum-size-negative-int #.(- (1- (expt 2 (1- (* (foreign-type-size :un…
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 typ…
99 ;; we cannot really test more than one type in a platform independent …
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…
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)
You are viewing proxied material from bitreich.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.