Coverage report: /home/luis/src/cffi/src/strings.lisp
Kind | Covered | All | % |
expression | 55 | 56 | 98.2 |
branch | 3 | 4 | 75.0 |
Key
Not instrumented
Executed
Not executed
Both branches taken
One branch taken
Neither branch taken
1
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3
;;; strings.lisp --- Operations on foreign strings.
5
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
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.
30
;;; FIXME: we used to support ub8 arrays here. Look into that.
32
;;;# Foreign String Conversion
34
;;; Functions for converting NULL-terminated C-strings to Lisp strings
35
;;; and vice versa. The string functions accept an ENCODING keyword
36
;;; argument which is used to specify the encoding to use when
37
;;; converting to/from foreign strings.
39
;;; Currently, encodings are really only supported on Unicode Lisps,
40
;;; to avoid encumbering CFFI with lots of character conversion tables
41
;;; and such. On Lisps with 8-bit characters, Lisp characters will be
42
;;; converted into bytes without conversion.
44
(defun lisp-string-to-foreign (string buffer bufsize
45
&key (encoding (default-encoding)))
46
"Copy characters from a Lisp STRING as bytes encoded with
47
ENCODING into BUFFER of BUFSIZE bytes. The resulting string will
48
always be null-terminated, but may be truncated if the octet
49
representation and null terminator are larger than BUFSIZE."
50
(%lisp-string-into-foreign string encoding buffer bufsize))
52
(defun foreign-string-to-lisp (pointer &key (offset 0) count
53
(encoding (default-encoding)))
54
"Copy at most COUNT bytes from POINTER plus OFFSET encoded in
55
ENCODING into a Lisp string and return it. If POINTER is a null
56
pointer, this returns nil."
57
(unless (null-pointer-p pointer)
58
(%foreign-string-to-lisp pointer encoding :offset offset
61
;;;# Using Foreign Strings
63
(defun foreign-string-alloc (string &key (encoding (default-encoding))
65
"Allocate a foreign string containing Lisp string STRING.
66
The string must be freed with FOREIGN-STRING-FREE."
67
(%lisp-string-to-foreign string encoding :start start :end end))
69
;;; Too lazy to write a %foreign-string-free in all backends, so this
70
;;; ackward thing is here to remind me that a definterface and
71
;;; defimplementation kind of thing (like what SLIME has) would be
73
#-#.(cl:if (cl:find-symbol (cl:symbol-name '#:foreign-string-free) '#:cffi-sys)
75
(defun foreign-string-free (ptr)
76
"Free a foreign string allocated by FOREIGN-STRING-ALLOC."
79
(defmacro with-foreign-string ((var lisp-string &rest args) &body body)
80
"Bind VAR to a foreign string containing LISP-STRING in BODY."
81
`(let ((,var (foreign-string-alloc ,lisp-string ,@args)))
84
(foreign-string-free ,var))))
86
(defmacro with-foreign-pointer-as-string
87
((var size &optional size-var) &body body)
88
"Like WITH-FOREIGN-POINTER except VAR as a Lisp string is used as
89
the return value of an implicit PROGN around BODY."
90
`(with-foreign-pointer (,var ,size ,size-var)
93
(foreign-string-to-lisp ,var))))
95
;;;# Automatic Conversion of Foreign Strings
97
(define-foreign-type foreign-string-type ()
98
(;; CFFI encoding of this string.
99
(encoding :initform (default-encoding) :initarg :encoding :reader encoding))
100
(:actual-type :pointer))
102
(define-parse-method :string (&key (encoding (default-encoding)))
103
(make-instance 'foreign-string-type :encoding encoding))
105
;;; Display the encoding when printing a FOREIGN-STRING-TYPE instance.
106
(defmethod print-object ((type foreign-string-type) stream)
107
(print-unreadable-object (type stream :type t)
108
(format stream "~S" (encoding type))))
110
(defmethod translate-to-foreign ((s string) (type foreign-string-type))
111
(values (foreign-string-alloc s :encoding (encoding type)) t))
113
(defmethod translate-to-foreign (obj (type foreign-string-type))
117
;; ((typep obj '(array (unsigned-byte 8)))
118
;; (values (foreign-string-alloc obj) t))
119
(t (error "~A is not a Lisp string, (array (unsigned-byte 8)) or pointer."
122
(defmethod translate-from-foreign (ptr (type foreign-string-type))
123
(foreign-string-to-lisp ptr :encoding (encoding type)))
125
(defmethod free-translated-object (ptr (type foreign-string-type) free-p)
127
(foreign-string-free ptr)))
131
(define-foreign-type foreign-string+ptr-type (foreign-string-type)
134
(define-parse-method :string+ptr (&key (encoding (default-encoding)))
135
(make-instance 'foreign-string+ptr-type :encoding encoding))
137
(defmethod translate-from-foreign (value (type foreign-string+ptr-type))
138
(list (foreign-string-to-lisp value) value))