Coverage report: /home/luis/src/cffi/src/features.lisp
Kind | Covered | All | % |
expression | 17 | 26 | 65.4 |
branch | 8 | 10 | 80.0 |
Key
Not instrumented
Executed
Not executed
Both branches taken
One branch taken
Neither branch taken
1
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3
;;; features.lisp --- CFFI-specific features.
5
;;; Copyright (C) 2006-2007, Luis Oliveira <loliveira@common-lisp.net>
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 #:cl-user)
30
(eval-when (:compile-toplevel :load-toplevel :execute)
31
(pushnew :cffi *features*))
33
;;; CFFI-SYS backends take care of pushing the appropriate features to
34
;;; *features*. See each cffi-*.lisp file.
36
(defpackage #:cffi-features
41
;; Features related to the CFFI-SYS backend. Why no-*? This
42
;; reflects the hope that these symbols will go away completely
43
;; meaning that at some point all lisps will support long-longs,
44
;; the foreign-funcall primitive, etc...
50
;; Only SCL supports long-double...
53
;; Features related to the operating system.
54
;; More should be added.
59
;; Features related to the processor.
60
;; More should be added.
66
(in-package #:cffi-features)
68
(defun cffi-feature-p (feature-expression)
69
"Matches a FEATURE-EXPRESSION against those symbols in *FEATURES*
70
that belong to the CFFI-FEATURES package."
71
(when (eql feature-expression t)
72
(return-from cffi-feature-p t))
73
(let ((features-package (find-package '#:cffi-features)))
74
(flet ((cffi-feature-eq (name feature-symbol)
75
(and (eq (symbol-package feature-symbol) features-package)
76
(string= name (symbol-name feature-symbol)))))
77
(etypecase feature-expression
79
(not (null (member (symbol-name feature-expression) *features*
80
:test #'cffi-feature-eq))))
82
(ecase (first feature-expression)
83
(:and (every #'cffi-feature-p (rest feature-expression)))
84
(:or (some #'cffi-feature-p (rest feature-expression)))
85
(:not (not (cffi-feature-p (cadr feature-expression))))))))))