3rdparties/software/cffi_0.21.0/tests/funcall.lisp (8245 bytes)
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 ;;; 3 ;;; funcall.lisp --- Tests function calling. 4 ;;; 5 ;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com> 6 ;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net> 7 ;;; 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: 15 ;;; 16 ;;; The above copyright notice and this permission notice shall be 17 ;;; included in all copies or substantial portions of the Software. 18 ;;; 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. 27 ;;; 28 29 (in-package #:cffi-tests) 30 31 ;;;# Calling with Built-In C Types 32 ;;; 33 ;;; Tests calling standard C library functions both passing and 34 ;;; returning each built-in type. 35 36 ;;; Don't run these tests if the implementation does not support 37 ;;; foreign-funcall. 38 #-cffi-sys::no-foreign-funcall 39 (progn 40 41 (deftest funcall.char 42 (foreign-funcall "toupper" :char (char-code #\a) :char) 43 #.(char-code #\A)) 44 45 (deftest funcall.int.1 46 (foreign-funcall "abs" :int -100 :int) 47 100) 48 49 (defun funcall-abs (n) 50 (foreign-funcall "abs" :int n :int)) 51 52 ;;; regression test: lispworks's %foreign-funcall based on creating 53 ;;; and caching foreign-funcallables at macro-expansion time. 54 (deftest funcall.int.2 55 (funcall-abs -42) 56 42) 57 58 (deftest funcall.long 59 (foreign-funcall "labs" :long -131072 :long) 60 131072) 61 62 #-cffi-sys::no-long-long 63 (deftest funcall.long-long 64 (foreign-funcall "my_llabs" :long-long -9223372036854775807 :long-long) 65 9223372036854775807) 66 67 #-cffi-sys::no-long-long 68 (deftest funcall.unsigned-long-long 69 (let ((ullong-max (1- (expt 2 (* 8 (foreign-type-size :unsigned-long-long)))))) 70 (eql ullong-max 71 (foreign-funcall "ullong" :unsigned-long-long ullong-max 72 :unsigned-long-long))) 73 t) 74 75 (deftest funcall.float 76 (foreign-funcall "my_sqrtf" :float 16.0 :float) 77 4.0) 78 79 (deftest funcall.double 80 (foreign-funcall "sqrt" :double 36.0d0 :double) 81 6.0d0) 82 83 #+(and scl long-float) 84 (deftest funcall.long-double 85 (foreign-funcall "sqrtl" :long-double 36.0l0 :long-double) 86 6.0l0) 87 88 (deftest funcall.string.1 89 (foreign-funcall "strlen" :string "Hello" :int) 90 5) 91 92 (deftest funcall.string.2 93 (with-foreign-pointer-as-string (s 100) 94 (setf (mem-ref s :char) 0) 95 (foreign-funcall "strcpy" :pointer s :string "Hello" :pointer) 96 (foreign-funcall "strcat" :pointer s :string ", world!" :pointer)) 97 "Hello, world!") 98 99 (deftest funcall.string.3 100 (with-foreign-pointer (ptr 100) 101 (lisp-string-to-foreign "Hello, " ptr 8) 102 (foreign-funcall "strcat" :pointer ptr :string "world!" :string)) 103 "Hello, world!") 104 105 ;;;# Calling Varargs Functions 106 107 (deftest funcall.varargs.nostdlib 108 (foreign-funcall-varargs 109 "sum_double_arbitrary" (:int 26) 110 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0 111 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0 112 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0 113 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0 114 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0 115 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0 116 :double 3.14d0 :double 3.14d0 117 :double) 118 81.64d0) 119 120 ;; The CHAR argument must be passed as :INT because chars are promoted 121 ;; to ints when passed as variable arguments. 122 (deftest funcall.varargs.char 123 (with-foreign-pointer-as-string (s 100) 124 (setf (mem-ref s :char) 0) 125 (foreign-funcall-varargs 126 "sprintf" (:pointer s :string "%c") :int 65 :int)) 127 "A") 128 129 (deftest funcall.varargs.int 130 (with-foreign-pointer-as-string (s 100) 131 (setf (mem-ref s :char) 0) 132 (foreign-funcall-varargs 133 "sprintf" (:pointer s :string "%d") :int 1000 :int)) 134 "1000") 135 136 (deftest funcall.varargs.long 137 (with-foreign-pointer-as-string (s 100) 138 (setf (mem-ref s :char) 0) 139 (foreign-funcall-varargs 140 "sprintf" (:pointer s :string "%ld") 141 :long 131072 :int)) 142 "131072") 143 144 ;;; There is no FUNCALL.VARARGS.FLOAT as floats are promoted to double 145 ;;; when passed as variable arguments. Currently this fails in SBCL 146 ;;; and CMU CL on Darwin/ppc. 147 (deftest funcall.varargs.double 148 (with-foreign-pointer-as-string (s 100) 149 (setf (mem-ref s :char) 0) 150 (foreign-funcall-varargs 151 "sprintf" (:pointer s :string "%.2f") :double (coerce pi 'double-float) :int)) 152 "3.14") 153 154 #+(and scl long-float) 155 (deftest funcall.varargs.long-double 156 (with-foreign-pointer-as-string (s 100) 157 (setf (mem-ref s :char) 0) 158 (foreign-funcall-varargs 159 "sprintf" :pointer s :string "%.2Lf" :long-double pi :int)) 160 "3.14") 161 162 (deftest funcall.varargs.string 163 (with-foreign-pointer-as-string (s 100) 164 (setf (mem-ref s :char) 0) 165 (foreign-funcall-varargs 166 "sprintf" (:pointer s :string "%s, %s!") :string "Hello" :string "world" :int)) 167 "Hello, world!") 168 169 ;;; See DEFCFUN.DOUBLE26. 170 (deftest funcall.double26 171 (foreign-funcall "sum_double26" 172 :double 3.14d0 :double 3.14d0 :double 3.14d0 173 :double 3.14d0 :double 3.14d0 :double 3.14d0 174 :double 3.14d0 :double 3.14d0 :double 3.14d0 175 :double 3.14d0 :double 3.14d0 :double 3.14d0 176 :double 3.14d0 :double 3.14d0 :double 3.14d0 177 :double 3.14d0 :double 3.14d0 :double 3.14d0 178 :double 3.14d0 :double 3.14d0 :double 3.14d0 179 :double 3.14d0 :double 3.14d0 :double 3.14d0 180 :double 3.14d0 :double 3.14d0 :double) 181 81.64d0) 182 183 ;;; See DEFCFUN.FLOAT26. 184 (deftest funcall.float26 185 (foreign-funcall "sum_float26" 186 :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0 187 :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0 188 :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0 189 :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0 190 :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0 191 :float 5.0 :float) 192 130.0) 193 194 ;;; Funcalling a pointer. 195 (deftest funcall.f-s-p.1 196 (foreign-funcall-pointer (foreign-symbol-pointer "abs") nil :int -42 :int) 197 42) 198 199 ;;;# Namespaces 200 201 #-cffi-sys::flat-namespace 202 (deftest funcall.namespace.1 203 (values (foreign-funcall ("ns_function" :library libtest) :boolean) 204 (foreign-funcall ("ns_function" :library libtest2) :boolean)) 205 t nil) 206 207 ;;;# stdcall 208 209 #+(and x86 windows (not cffi-sys::no-stdcall)) 210 (deftest funcall.stdcall.1 211 (flet ((fun () 212 (foreign-funcall ("stdcall_fun@12" :convention :stdcall) 213 :int 1 :int 2 :int 3 :int))) 214 (loop repeat 100 do (fun) 215 finally (return (fun)))) 216 6) 217 218 ;;; RT: NIL arguments are skipped 219 220 (defvar *nil-skipped*) 221 222 (define-foreign-type check-nil-skip-type () 223 () 224 (:actual-type :pointer) 225 (:simple-parser check-nil-skip-type)) 226 227 (defmethod expand-to-foreign (val (type check-nil-skip-type)) 228 (declare (ignore val)) 229 (setf *nil-skipped* nil) 230 (null-pointer)) 231 232 (deftest funcall.nil-skip 233 (let ((*nil-skipped* t)) 234 (compile nil '(lambda () 235 (foreign-funcall "abs" check-nil-skip-type nil))) 236 *nil-skipped*) 237 nil) 238 239 ;;; RT: CLISP returns NIL instead of a null-pointer 240 241 (deftest funcall.pointer-not-nil 242 (not (null (foreign-funcall "strchr" :string "" :int 1 :pointer))) 243 t) 244 245 ) ;; #-cffi-sys::no-foreign-funcall