+cl-uffi (1.2.23-1) unstable; urgency=low
+
+ * New upstream with fixes suggested and patches submitted by Edi Weitz.
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Thu, 14 Aug 2003 12:26:07 -0600
+
cl-uffi (1.2.22-1) unstable; urgency=low
* New upstream with Lispworks patch from Edi Weitz
<refsect1>
<title>Examples</title>
<programlisting>
-(def-array ca :char)
+(def-array-pointer ca :char)
(let ((fs (convert-to-foreign-string "ab")))
(values (null-char-p (deref-array fs 'ca 0))
(null-char-p (deref-array fs 'ca 2))))
&t;
</programlisting>
</refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>
+ The TYPE argument is ignored for CL implementations other than
+ AllegroCL. If you want to cast a pointer to another type use
+ WITH-CAST-POINTER together with DEREF-POINTER/DEREF-ARRAY.
+ </para>
+ </refsect1>
<refsect1>
<title>Side Effects</title>
<para>None.</para>
</programlisting>
</para>
</refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>
+ The TYPE argument is ignored for CL implementations other than
+ AllegroCL. If you want to cast a pointer to another type use
+ WITH-CAST-POINTER together with DEREF-POINTER/DEREF-ARRAY.
+ </para>
+ </refsect1>
<refsect1>
<title>Side Effects</title>
<para>None.</para>
<refsect1>
<title>Description</title>
<para>
- Ensures that an object obtained by dereferencing a
-<constant>:char</constant> pointer is a character.
+ Ensures that an objects obtained by dereferencing
+<constant>:char</constant> and <constant>:unsigned-char</constant>
+pointers are a lisp character.
</para>
</refsect1>
<refsect1>
</refsect1>
</refentry>
+ <refentry id="with-cast-pointer">
+ <refnamediv>
+ <refname>with-cast-pointer</refname>
+ <refpurpose>Wraps a body of code with a pointer cast to a new type.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>with-cast-pointer</function> <replaceable>binding-name ptr type & body body</replaceable> => <returnvalue>value</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>ptr</parameter></term>
+ <listitem>
+ <para>A pointer to a foreign object.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A foreign type of the object being pointed to.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>value</returnvalue></term>
+ <listitem>
+ <para>The value of the object where the pointer points.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Executes BODY with POINTER casted to be a pointer to type TYPE. If
+ BINDING-NAME is provided the casted pointer will be bound to this
+ name during the execution of BODY. If BINDING-NAME is not provided
+ POINTER must be a name bound to the pointer which should be
+ casted. This name will be bound to the casted pointer during the
+ execution of BODY.
+
+ This is a no-op in AllegroCL but will wrap BODY in a LET form if
+ BINDING-NAME is provided.
+
+ This macro is meant to be used in conjunction with DEREF-POINTER or
+ DEREF-ARRAY. In Allegro CL the "cast" will actually take place in
+ DEREF-POINTER or DEREF-ARRAY.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
</reference>
<reference>
<refsect1>
<title>Syntax</title>
<synopsis>
- <function>load-foreign-library</function> <replaceable>filename &key module supporting-libraries</replaceable> => <returnvalue>success</returnvalue>
+ <function>load-foreign-library</function> <replaceable>filename &key module supporting-libraries force-load</replaceable> => <returnvalue>success</returnvalue>
</synopsis>
</refsect1>
<refsect1>
</para>
</listitem>
</varlistentry>
+ <varlistentry>
+ <term><parameter>force-load</parameter></term>
+ <listitem>
+ <para>Forces the loading of the library if it has been previously loaded.
+ </para>
+ </listitem>
+ </varlistentry>
<varlistentry>
<term><returnvalue>success</returnvalue></term>
<listitem>
<title>Description</title>
<para>Loads a foreign library. Applies a module name to functions
within the library. Ensures that a library is only loaded once during
-a session.
+a session. A library can be reloaded by using the <symbol>:force-load</symbol> key.
</para>
</refsect1>
<refsect1>
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: libraries.lisp,v 1.9 2003/07/08 12:37:21 kevin Exp $
+;;;; $Id: libraries.lisp,v 1.10 2003/08/14 19:35:05 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(defun load-foreign-library (filename &key module supporting-libraries
force-load)
- #+(or allegro lispworks mcl) (declare (ignore module supporting-libraries))
+ #+(or allegro mcl) (declare (ignore module supporting-libraries))
#+(or cmu scl sbcl) (declare (ignore module))
(when (and filename (probe-file filename))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: objects.lisp,v 1.15 2003/07/08 12:37:21 kevin Exp $
+;;;; $Id: objects.lisp,v 1.16 2003/08/14 19:35:05 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
#+mcl
(defsetf deref-pointer deref-pointer-set)
-#+(or lispworks (and mcl (not openmcl))) ;; with LW, deref is a character
+#+lispworks
+(defmacro ensure-char-character (obj)
+ `(if (characterp ,obj) ,obj (code-char ,obj)))
+
+#+(and mcl (not openmcl))
(defmacro ensure-char-character (obj)
obj)
`(with-foreign-objects ((,var ,type))
,@body))
+#+lispworks
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ `(fli:with-coerced-pointer (,binding-name
+ :type ',(convert-from-uffi-type (eval type) :type))
+ ,pointer
+ ,@body))
+
+#+(or cmu scl sbcl)
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ `(let ((,binding-name
+ (#+(or cmu scl) alien:cast
+ #+sbcl sb-alien:cast
+ ,pointer (* ,(convert-from-uffi-type (eval type) :type)))))
+ ,@body))
+
+#+allegro
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ (declare (ignore type))
+ `(let ((,binding-name ,pointer))
+ ,@body))
+
+#-(or lispworks cmu scl sbcl allegro)
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ (declare (ignore binding-name pointer type))
+ '(error "WITH-CAST-POINTER not (yet) implemented for ~A"
+ (lisp-implementation-type)))
+
#:make-null-pointer
#:+null-cstring-pointer+
#:char-array-to-pointer
+ #:with-cast-pointer
;; string functions
#:convert-from-cstring
--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: casts
+;;;; Purpose: Tests of with-cast-pointer
+;;;; Programmer: Kevin M. Rosenberg / Edi Weitz
+;;;; Date Started: Aug 2003
+;;;;
+;;;; $Id: casts.lisp,v 1.1 2003/08/14 19:35:05 kevin Exp $
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-function ("cast_test_int" cast-test-int)
+ ()
+ :returning :pointer-void)
+
+(uffi:def-function ("cast_test_float" cast-test-float)
+ ()
+ :returning :pointer-void)
+
+(deftest cast.1
+ (progn
+ (uffi:with-cast-pointer (temp (cast-test-int) :int)
+ (assert (= (uffi:deref-pointer temp :int) 23)))
+ (let ((result (cast-test-int)))
+ (uffi:with-cast-pointer (result2 result :int)
+ (assert (= (uffi:deref-pointer result2 :int) 23)))
+ (uffi:with-cast-pointer (temp result :int)
+ (assert (= (uffi:deref-pointer temp :int) 23))))
+ t)
+ t)
+
+(deftest cast.2
+ (progn
+ (uffi:with-cast-pointer (temp (cast-test-float) :double)
+ (assert (= (uffi:deref-pointer temp :double) 3.21d0)))
+ (let ((result (cast-test-float)))
+ (uffi:with-cast-pointer (result2 result :double)
+ (assert (= (uffi:deref-pointer result2 :double) 3.21d0)))
+ (uffi:with-cast-pointer (temp result :double)
+ (assert (= (uffi:deref-pointer temp :double) 3.21d0))))
+ t)
+ t)
+
--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: pointers.lisp
+;;;; Purpose: Test file for UFFI pointers
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Aug 2003
+;;;;
+;;;; $Id: pointers.lisp,v 1.1 2003/08/14 19:35:05 kevin Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(deftest chptr.1
+ (let ((native-string "test string"))
+ (uffi:with-foreign-string (fs native-string)
+ (characterp
+ (ensure-char-character
+ (deref-pointer fs :char)))))
+ t)
+
+(deftest chptr.2
+ (let ((native-string "test string"))
+ (uffi:with-foreign-string (fs native-string)
+ (characterp
+ (ensure-char-character
+ (deref-pointer fs :unsigned-char)))))
+ t)
+
+(deftest chptr.3
+ (let ((native-string "test string"))
+ (uffi:with-foreign-string (fs native-string)
+ (numberp
+ (deref-pointer fs :byte))))
+ t)
+
+
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: structs.lisp
-;;;; Purpose: UFFI Example file to strtol, uses pointer arithmetic
+;;;; Purpose: Test file for UFFI structures
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: structs.lisp,v 1.1 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id: structs.lisp,v 1.2 2003/08/14 19:35:05 kevin Exp $
;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************
(uffi:def-foreign-type foo-ptr (* foo))
-(uffi:def-function "baz"
- ((x :int))
- :returning foo-ptr
- :module "frob")
-
-(defun test ()
+;; tests that compilation worked
+(deftest structs.1
(with-foreign-object (p 'foo)
- (baz p)))
+ t)
+ t)
* Programer: Kevin M. Rosenberg
* Date Started: Mar 2002
*
- * CVS Id: $Id: uffi-c-test-lib.c,v 1.1 2003/04/29 14:08:02 kevin Exp $
+ * CVS Id: $Id: uffi-c-test-lib.c,v 1.2 2003/08/14 19:35:05 kevin Exp $
*
* This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
*
+DLLEXPORT
+void *
+cast_test_int () {
+ int *x = (int *) malloc(sizeof(int));
+ *x = 23;
+ return x;
+}
+
+DLLEXPORT
+void *
+cast_test_float ()
+{
+ double *y = (double *) malloc(sizeof(double));
+ *y = 3.21;
+ return y;
+}
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id: uffi-tests.asd,v 1.8 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id: uffi-tests.asd,v 1.9 2003/08/14 19:35:05 kevin Exp $
;;;; *************************************************************************
(defpackage #:uffi-tests-system
(:file "union" :depends-on ("package"))
(:file "arrays" :depends-on ("package"))
(:file "structs" :depends-on ("package"))
+ (:file "pointers" :depends-on ("package"))
(:file "time" :depends-on ("package"))
(:file "foreign-loader" :depends-on ("package"))
- (:file "compress" :depends-on ("foreign-loader"))
(:file "uffi-c-test-lib" :depends-on ("foreign-loader"))
+ (:file "compress" :depends-on ("foreign-loader"))
+ (:file "casts" :depends-on ("foreign-loader"))
))))
(defmethod perform ((o test-op) (c (eql (find-system :uffi-tests))))
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: uffi.asd,v 1.27 2003/07/18 21:33:25 kevin Exp $
+;;;; $Id: uffi.asd,v 1.28 2003/08/14 19:35:05 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
#+(or allegro lispworks cmu mcl cormanlisp sbcl scl)
(defmethod perform ((o test-op) (c (eql (find-system 'uffi))))
(oos 'load-op 'uffi-tests)
- (oos 'test-op 'uffi-tests))
+ (oos 'test-op 'uffi-tests :force t))
projects / uffi.git / commitdiff