1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3 ;;; funcall.lisp --- Tests function calling.
5 ;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
6 ;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
8 ;;; Permission is hereby granted, free of charge, to any person
9 ;;; obtaining a copy of this software and associated documentation
10 ;;; files (the "Software"), to deal in the Software without
11 ;;; restriction, including without limitation the rights to use, copy,
12 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
13 ;;; of the Software, and to permit persons to whom the Software is
14 ;;; furnished to do so, subject to the following conditions:
16 ;;; The above copyright notice and this permission notice shall be
17 ;;; included in all copies or substantial portions of the Software.
19 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
20 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
21 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
22 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
23 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
24 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
25 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
26 ;;; DEALINGS IN THE SOFTWARE.
29 (in-package #:cffi-tests
)
31 ;;;# Calling with Built-In C Types
33 ;;; Tests calling standard C library functions both passing and
34 ;;; returning each built-in type.
36 ;;; Don't run these tests if the implementation does not support
38 #-cffi-features
:no-foreign-funcall
42 (foreign-funcall "toupper" :char
(char-code #\a) :char
)
45 (deftest funcall.int
.1
46 (foreign-funcall "abs" :int -
100 :int
)
49 (defun funcall-abs (n)
50 (foreign-funcall "abs" :int n
:int
))
52 ;;; regression test: lispworks's %foreign-funcall based on creating
53 ;;; and caching foreign-funcallables at macro-expansion time.
54 (deftest funcall.int
.2
59 (foreign-funcall "labs" :long -
131072 :long
)
62 #-cffi-features
:no-long-long
63 (deftest funcall.long-long
64 (foreign-funcall "my_llabs" :long-long -
9223372036854775807 :long-long
)
67 (deftest funcall.float
68 (foreign-funcall "my_sqrtf" :float
16.0 :float
)
71 (deftest funcall.double
72 (foreign-funcall "sqrt" :double
36.0d0
:double
)
75 #+(and scl long-float
)
76 (deftest funcall.long-double
77 (foreign-funcall "sqrtl" :long-double
36.0l0 :long-double
)
80 (deftest funcall.string
.1
81 (foreign-funcall "strlen" :string
"Hello" :int
)
84 (deftest funcall.string
.2
85 (with-foreign-pointer-as-string (s 100)
86 (setf (mem-ref s
:char
) 0)
87 (foreign-funcall "strcpy" :pointer s
:string
"Hello" :pointer
)
88 (foreign-funcall "strcat" :pointer s
:string
", world!" :pointer
))
91 (deftest funcall.string
.3
92 (with-foreign-pointer (ptr 100)
93 (lisp-string-to-foreign "Hello, " ptr
8)
94 (foreign-funcall "strcat" :pointer ptr
:string
"world!" :string
))
97 ;;;# Calling Varargs Functions
99 ;; The CHAR argument must be passed as :INT because chars are promoted
100 ;; to ints when passed as variable arguments.
101 (deftest funcall.varargs.char
102 (with-foreign-pointer-as-string (s 100)
103 (setf (mem-ref s
:char
) 0)
104 (foreign-funcall "sprintf" :pointer s
:string
"%c" :int
65 :int
))
107 (deftest funcall.varargs.int
108 (with-foreign-pointer-as-string (s 100)
109 (setf (mem-ref s
:char
) 0)
110 (foreign-funcall "sprintf" :pointer s
:string
"%d" :int
1000 :int
))
113 (deftest funcall.varargs.long
114 (with-foreign-pointer-as-string (s 100)
115 (setf (mem-ref s
:char
) 0)
116 (foreign-funcall "sprintf" :pointer s
:string
"%ld" :long
131072 :int
))
119 ;;; There is no FUNCALL.VARARGS.FLOAT as floats are promoted to double
120 ;;; when passed as variable arguments. Currently this fails in SBCL
121 ;;; and CMU CL on Darwin/ppc.
122 (deftest funcall.varargs.double
123 (with-foreign-pointer-as-string (s 100)
124 (setf (mem-ref s
:char
) 0)
125 (foreign-funcall "sprintf" :pointer s
:string
"%.2f"
126 :double
(coerce pi
'double-float
) :int
))
129 #+(and scl long-float
)
130 (deftest funcall.varargs.long-double
131 (with-foreign-pointer-as-string (s 100)
132 (setf (mem-ref s
:char
) 0)
133 (foreign-funcall "sprintf" :pointer s
:string
"%.2Lf"
134 :long-double pi
:int
))
137 (deftest funcall.varargs.string
138 (with-foreign-pointer-as-string (s 100)
139 (setf (mem-ref s
:char
) 0)
140 (foreign-funcall "sprintf" :pointer s
:string
"%s, %s!"
141 :string
"Hello" :string
"world" :int
))
144 ;;; See DEFCFUN.DOUBLE26.
145 (deftest funcall.double26
146 (foreign-funcall "sum_double26"
147 :double
3.14d0
:double
3.14d0
:double
3.14d0
148 :double
3.14d0
:double
3.14d0
:double
3.14d0
149 :double
3.14d0
:double
3.14d0
:double
3.14d0
150 :double
3.14d0
:double
3.14d0
:double
3.14d0
151 :double
3.14d0
:double
3.14d0
:double
3.14d0
152 :double
3.14d0
:double
3.14d0
:double
3.14d0
153 :double
3.14d0
:double
3.14d0
:double
3.14d0
154 :double
3.14d0
:double
3.14d0
:double
3.14d0
155 :double
3.14d0
:double
3.14d0
:double
)
158 ;;; See DEFCFUN.FLOAT26.
159 (deftest funcall.float26
160 (foreign-funcall "sum_float26"
161 :float
5.0 :float
5.0 :float
5.0 :float
5.0 :float
5.0
162 :float
5.0 :float
5.0 :float
5.0 :float
5.0 :float
5.0
163 :float
5.0 :float
5.0 :float
5.0 :float
5.0 :float
5.0
164 :float
5.0 :float
5.0 :float
5.0 :float
5.0 :float
5.0
165 :float
5.0 :float
5.0 :float
5.0 :float
5.0 :float
5.0
169 ;;; Funcalling a pointer.
170 (deftest funcall.f-s-p
.1
171 (foreign-funcall-pointer (foreign-symbol-pointer "abs") nil
:int -
42 :int
)
176 #-cffi-features
:flat-namespace
177 (deftest funcall.namespace
.1
178 (values (foreign-funcall ("ns_function" :library libtest
) :boolean
)
179 (foreign-funcall ("ns_function" :library libtest2
) :boolean
))
184 #+(and cffi-features
:x86
(not cffi-features
:no-stdcall
))
185 (deftest funcall.stdcall
.1
187 (foreign-funcall ("stdcall_fun@12" :cconv
:stdcall
)
188 :int
1 :int
2 :int
3 :int
)))
189 (loop repeat
100 do
(fun)
190 finally
(return (fun))))
193 ) ;; #-cffi-features:no-foreign-funcall