1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3 ;;; enum.lisp --- Tests on C enums.
5 ;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira(@)common-lisp.net>
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:
15 ;;; The above copyright notice and this permission notice shall be
16 ;;; included in all copies or substantial portions of the Software.
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.
28 (in-package #:cffi-tests
)
30 (defctype numeros-base-type
:int
)
32 (defcenum (numeros numeros-base-type
)
40 (defcfun "check_enums" :int
49 (check-enums :one
:two
:three
4 :forty-one
:forty-two
)
52 (defcenum another-boolean
:false
:true
)
53 (defcfun "return_enum" another-boolean
(x :uint
))
56 (and (eq :false
(return-enum 0))
57 (eq :true
(return-enum 1)))
60 (defctype yet-another-boolean another-boolean
)
61 (defcfun ("return_enum" return-enum2
) yet-another-boolean
62 (x yet-another-boolean
))
65 (and (eq :false
(return-enum2 :false
))
66 (eq :true
(return-enum2 :true
)))
69 (defctype numeros-typedef numeros
)
71 (deftest enum.typedef
.1
72 (eq (foreign-enum-keyword 'numeros-typedef
1)
73 (foreign-enum-keyword 'numeros
1))
76 (deftest enum.typedef
.2
77 (eql (foreign-enum-value 'numeros-typedef
:four
)
78 (foreign-enum-value 'numeros
:four
))
81 (defcenum enum-size.int
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))))))
87 (defcenum enum-size.uint
89 (enum-size-uint #.
(1- (expt 2 (* (foreign-type-size :unsigned-int
) 8))))
93 (mapcar (alexandria:compose
'cffi
::unparse-type
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.
104 (deftest enum.size.members
105 (mapcar (alexandria:conjoin
'boundp
'constantp
)
106 '(enum-size-int enum-size-negative-int enum-size-uint
))
109 (deftest enum.size.error-when-too-large
111 (eval '(defcenum enum-size-too-large
112 (:too-long
#.
(expt 2 129)))))
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
118 (defcenum (enum.double
:double
)
126 (mapcar (alexandria:curry
'foreign-enum-value
'enum.double
)
127 '(:one
:two
:three
:four
)))
133 ;; Test undeclared values
134 (defcenum (enum.undeclared
:int
:allow-undeclared-values T
)
138 (deftest enum.undeclared
139 (with-foreign-object (enum 'enum.undeclared
3)
140 (setf (mem-aref enum
'enum.undeclared
0) 1)
141 (setf (mem-aref enum
'enum.undeclared
1) 2)
142 (setf (mem-aref enum
'enum.undeclared
2) 3)
143 (values (mem-aref enum
'enum.undeclared
0)
144 (mem-aref enum
'enum.undeclared
1)
145 (mem-aref enum
'enum.undeclared
2)))
152 ;;; Regression test: defbitfield was misbehaving when the first value
155 (eval '(defbitfield (bf1 :long
)
170 (mapcar (lambda (symbol)
171 (foreign-bitfield-value 'bf2
(list symbol
)))
172 '(one two four eight sixteen thirty-two sixty-four
))
175 (deftest bitfield
.2.outlier
176 (mapcar (lambda (symbol)
177 (foreign-bitfield-value 'bf2
(list symbol
)))
178 '(one two four eight sixteen thirty-two sixty-four
))
181 (defbitfield (bf3 :int
)
189 ;;; Non-single-bit numbers must not influence the progression of
190 ;;; implicit values. Single bits larger than any before *must*
191 ;;; influence said progression.
193 (mapcar (lambda (symbol)
194 (foreign-bitfield-value 'bf3
(list symbol
)))
199 ;; zero will be a simple enum member because it's not a valid mask
207 ;;; Yet another edge case with the 0...
209 ;; These should macroexpand to the literals in Slime
210 ;; due to the compiler macros. Same below.
211 (values (foreign-bitfield-value 'bf4
())
212 (foreign-bitfield-value 'bf4
'one
)
213 (foreign-bitfield-value 'bf4
'(one two
))
214 (foreign-bitfield-value 'bf4
'(three)) ; or should it signal an error?
215 (foreign-bitfield-value 'bf4
'(sixteen)))
223 (values (foreign-bitfield-symbols 'bf4
0)
224 (foreign-bitfield-symbols 'bf4
1)
225 (foreign-bitfield-symbols 'bf4
3)
226 (foreign-bitfield-symbols 'bf4
8)
227 (foreign-bitfield-symbols 'bf4
16))
234 (deftest bitfield.translators
235 (with-foreign-object (bf 'bf4
2)
236 (setf (mem-aref bf
'bf4
0) 1)
237 (setf (mem-aref bf
'bf4
1) 3)
238 (values (mem-aref bf
'bf4
0)
239 (mem-aref bf
'bf4
1)))
244 (deftest bitfield.base-type-error
246 (eval '(defbitfield (bf1 :float
)