1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3 ;;; fsbv.lisp --- Tests of foreign structure by value calls.
5 ;;; Copyright (C) 2011, Liam M. Healy
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 ;; Requires struct.lisp
32 (defcfun "sumpair" :int
33 (p (:struct struct-pair
)))
35 (defcfun "makepair" (:struct struct-pair
)
38 (defcfun "doublepair" (:struct struct-pair
)
39 (p (:struct struct-pair
)))
41 (defcfun "prodsumpair" :double
42 (p (:struct struct-pair
+double
)))
44 (defcfun "doublepairdouble" (:struct struct-pair
+double
)
45 (p (:struct struct-pair
+double
)))
47 ;;; Call struct by value
53 (deftest (fsbv.wfo
:expected-to-fail t
)
54 (with-foreign-object (arg '(:struct struct-pair
))
55 (convert-into-foreign-memory '(40 .
2) '(:struct struct-pair
) arg
)
59 ;;; Call and return struct by value
64 ;;; return struct by value
65 (deftest (fsbv.makepair
.1 :expected-to-fail t
)
69 (deftest (fsbv.makepair
.2 :expected-to-fail t
)
73 ;;; Call recursive structure by value
75 (prodsumpair '(pr (a 4 b
5) dbl
2.5d0
))
78 ;;; Call and return recursive structure by value
80 (let ((ans (doublepairdouble '(pr (a 4 b
5) dbl
2.5d0
))))
81 (values (getf (getf ans
'pr
) 'a
)
82 (getf (getf ans
'pr
) 'b
)
88 (defcstruct (struct-with-array :size
6)
89 (s1 (:array
:char
6)))
92 (p (:struct struct-with-array
)))
96 (defcfun ("sumpair" sumpair2
) :int
97 (p struct-pair-typedef1
))
103 (defcfun "returnpairpointer" (:pointer
(:struct struct-pair
))
104 (ignored (:struct struct-pair
)))
106 (deftest fsbv.return-a-pointer
107 (let ((ptr (returnpairpointer '(1 .
2))))
108 (+ (foreign-slot-value ptr
'(:struct struct-pair
) 'a
)
109 (foreign-slot-value ptr
'(:struct struct-pair
) 'b
)))
112 ;;; Test ulonglong on no-long-long implementations.
114 (defcfun "ullsum" :unsigned-long-long
115 (a :unsigned-long-long
) (b :unsigned-long-long
))
118 (ullsum #x10DEADBEEF
#x2300000000
)
121 ;;; Combine structures by value with a string argument
122 (defcfun "stringlenpair" (:struct struct-pair
)
124 (p (:struct struct-pair
)))
127 (stringlenpair "abc" '(1 .
2))
130 ;;; Combine structures by value with an enum argument
131 (defcfun "enumpair" (:int
)
133 (p (:struct struct-pair
)))
136 (enumpair :two
'(1 .
2))
139 ;;; returning struct with bitfield member (bug #1474631)
140 (defbitfield (struct-bitfield :unsigned-int
)
144 (defcstruct bitfield-struct
147 (defcfun "structbitfield" (:struct bitfield-struct
)
150 (defctype struct-bitfield-typedef struct-bitfield
)
152 (defcstruct bitfield-struct
.2
153 (b struct-bitfield-typedef
))
155 (defcfun ("structbitfield" structbitfield
.2) (:struct bitfield-struct
.2)
158 ;; these would get stuck in an infinite loop previously
159 (deftest fsbv.struct-bitfield
.0
163 (deftest fsbv.struct-bitfield
.1
167 (deftest fsbv.struct-bitfield
.2
171 (deftest fsbv.struct-bitfield
.3
175 ;;; Test for a discrepancy between normal and fsbv return values
176 (cffi:define-foreign-type int-return-code
(cffi::foreign-type-alias
)
178 (:default-initargs
:actual-type
(cffi::parse-type
:int
))
179 (:simple-parser int-return-code
))
181 (defmethod cffi:expand-from-foreign
(value (type int-return-code
))
182 ;; NOTE: strictly speaking it should be
183 ;; (cffi:convert-from-foreign ,value :int), but it's irrelevant in this case
184 `(let ((return-code ,value
))
185 (check-type return-code integer
)
188 (defcfun (noargs-with-typedef "noargs") int-return-code
)
190 (deftest fsbv.noargs-with-typedef
; for reference, not an FSBV call
191 (noargs-with-typedef)
194 (defcfun (sumpair-with-typedef "sumpair") int-return-code
195 (p (:struct struct-pair
)))
197 (deftest (fsbv.return-value-typedef
)
198 (sumpair-with-typedef '(40 .
2))