1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3 ;;; funcall.lisp --- Tests function calling.
5 ;;; Copyright (C) 2005, James Bielman <jamesjb@jamesjb.com>
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 ;;;# Calling with Built-In C Types
32 ;;; Tests calling standard C library functions both passing and
33 ;;; returning each built-in type.
36 (foreign-funcall "toupper" :char
(char-code #\a) :char
)
40 (foreign-funcall "abs" :int -
100 :int
)
44 (foreign-funcall "labs" :long -
131072 :long
)
47 (deftest funcall.float
48 (foreign-funcall "sqrtf" :float
16.0 :float
)
51 (deftest funcall.double
52 (foreign-funcall "sqrt" :double
36.0d0
:double
)
55 (deftest funcall.string
.1
56 (foreign-funcall "strlen" string
"Hello" :int
)
59 (deftest funcall.string
.2
60 (with-foreign-ptr-as-string (s 100)
61 (setf (mem-ref s
:char
) 0)
62 (foreign-funcall "strcpy" :pointer s string
"Hello" :pointer
)
63 (foreign-funcall "strcat" :pointer s string
", world!" :pointer
))
66 ;;;# Calling Varargs Functions
68 ;; The CHAR argument must be passed as :INT because chars are promoted
69 ;; to ints when passed as variable arguments.
70 (deftest funcall.varargs.char
71 (with-foreign-ptr-as-string (s 100)
72 (setf (mem-ref s
:char
) 0)
73 (foreign-funcall "sprintf" :pointer s string
"%c" :int
65 :void
))
76 (deftest funcall.varargs.int
77 (with-foreign-ptr-as-string (s 100)
78 (setf (mem-ref s
:char
) 0)
79 (foreign-funcall "sprintf" :pointer s string
"%d" :int
1000 :void
))
82 (deftest funcall.varargs.long
83 (with-foreign-ptr-as-string (s 100)
84 (setf (mem-ref s
:char
) 0)
85 (foreign-funcall "sprintf" :pointer s string
"%ld" :long
131072 :void
))
88 ;; There is no FUNCALL.VARARGS.FLOAT as floats are promoted to double
89 ;; when passed as variable arguments. Currently this fails in SBCL
90 ;; and CMU CL on Darwin/ppc.
91 (deftest funcall.varargs.double
92 (with-foreign-ptr-as-string (s 100)
93 (setf (mem-ref s
:char
) 0)
94 (foreign-funcall "sprintf" :pointer s string
"%.2f"
95 :double
(coerce pi
'double-float
) :void
))
98 (deftest funcall.varargs.string
99 (with-foreign-ptr-as-string (s 100)
100 (setf (mem-ref s
:char
) 0)
101 (foreign-funcall "sprintf" :pointer s string
"%s, %s!"
102 string
"Hello" string
"world" :void
))