bindings.lisp - clic - Clic is an command line interactive client for gopher wr… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
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))) |