GopherProxy

	tbindings.lisp - clic - Clic is an command line interactive client for gopher w…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	tbindings.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)))