bindings.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
bindings.lisp (5428B)
---
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; libtest.lisp --- Setup CFFI bindings for libtest.
4 ;;;
5 ;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira(@)common-lisp.net>
6 ;;;
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:
14 ;;;
15 ;;; The above copyright notice and this permission notice shall be
16 ;;; included in all copies or substantial portions of the Software.
17 ;;;
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.
26 ;;;
27
28 (in-package #:cffi-tests)
29
30 (define-foreign-library (libtest :type :test)
31 (:darwin (:or "libtest.dylib" "libtest32.dylib"))
32 (:unix (:or "libtest.so" "libtest32.so"))
33 (:windows "libtest.dll")
34 (t (:default "libtest")))
35
36 (define-foreign-library (libtest2 :type :test)
37 (:darwin (:or "libtest2.dylib" "libtest2_32.dylib"))
38 (:unix (:or "libtest2.so" "libtest2_32.so"))
39 (t (:default "libtest2")))
40
41 (define-foreign-library (libfsbv :type :test)
42 (:darwin (:or "libfsbv.dylib" "libfsbv32.dylib"))
43 (:unix (:or "libfsbv.so" "libfsbv_32.so"))
44 (:windows "libfsbv.dll")
45 (t (:default "libfsbv")))
46
47 (define-foreign-library libc
48 (:windows "msvcrt.dll"))
49
50 (define-foreign-library libm
51 #+(and lispworks darwin) ; not sure why the full path is necessary
52 (:darwin "/usr/lib/libm.dylib")
53 (t (:default "libm")))
54
55 (defmacro deftest (name &rest body)
56 (destructuring-bind (name &key expected-to-fail)
57 (alexandria:ensure-list name)
58 (let ((result `(rt:deftest ,name ,@body)))
59 (when expected-to-fail
60 (setf result `(progn
61 (when ,expected-to-fail
62 (pushnew ',name rt::*expected-failures*))
63 ,result)))
64 result)))
65
66 (defun call-within-new-thread (fn &rest args)
67 (let (result
68 error
69 (cv (bordeaux-threads:make-condition-variable))
70 (lock (bordeaux-threads:make-lock)))
71 (bordeaux-threads:with-lock-held (lock)
72 (bordeaux-threads:make-thread
73 (lambda ()
74 (multiple-value-setq (result error)
75 (ignore-errors (apply fn args)))
76 (bordeaux-threads:with-lock-held (lock)
77 (bordeaux-threads:condition-notify cv))))
78 (bordeaux-threads:condition-wait cv lock)
79 (values result error))))
80
81 ;;; As of OSX 10.6.6, loading CoreFoundation on something other than
82 ;;; the initial thread results in a crash.
83 (deftest load-core-foundation
84 (progn
85 #+bordeaux-threads
86 (call-within-new-thread 'load-foreign-library
87 '(:framework "CoreFoundation"))
88 t)
89 t)
90
91 ;;; Return the directory containing the source when compiling or
92 ;;; loading this file. We don't use *LOAD-TRUENAME* because the fasl
93 ;;; file may be in a different directory than the source with certain
94 ;;; ASDF extensions loaded.
95 (defun load-directory ()
96 (let ((here #.(or *compile-file-truename* *load-truename*)))
97 (make-pathname :name nil :type nil :version nil
98 :defaults here)))
99
100 (defun load-test-libraries ()
101 (let ((*foreign-library-directories* (list (load-directory))))
102 (load-foreign-library 'libtest)
103 (load-foreign-library 'libtest2)
104 (load-foreign-library 'libfsbv)
105 (load-foreign-library 'libc)
106 #+(or abcl lispworks) (load-foreign-library 'libm)))
107
108 #-(:and :ecl (:not :dffi))
109 (load-test-libraries)
110
111 #+(:and :ecl (:not :dffi))
112 (ffi:load-foreign-library
113 #.(make-pathname :name "libtest" :type "so"
114 :defaults (or *compile-file-truename* *load-truename*)))
115
116 ;;; check libtest version
117 (defparameter *required-dll-version* "20120107")
118
119 (defcvar "dll_version" :string)
120
121 (unless (string= *dll-version* *required-dll-version*)
122 (error "version check failed: expected ~s but libtest reports ~s"
123 *required-dll-version*
124 *dll-version*))
125
126 ;;; The maximum and minimum values for single and double precision C
127 ;;; floating point values, which may be quite different from the
128 ;;; corresponding Lisp versions.
129 (defcvar "float_max" :float)
130 (defcvar "float_min" :float)
131 (defcvar "double_max" :double)
132 (defcvar "double_min" :double)
133
134 (defun run-cffi-tests (&key (compiled nil))
135 (let ((regression-test::*compile-tests* compiled)
136 (*package* (find-package '#:cffi-tests)))
137 (format t "~&;;; running tests (~Acompiled)" (if compiled "" "un"))
138 (do-tests)
139 (set-difference (regression-test:pending-tests)
140 regression-test::*expected-failures*)))
141
142 (defun run-all-cffi-tests ()
143 (append (run-cffi-tests :compiled nil)
144 (run-cffi-tests :compiled t)))
145
146 (defmacro expecting-error (&body body)
147 `(handler-case (progn ,@body :no-error)
148 (error () :error)))