From a3db800bfa385ae39d729ef0eb8f08a78ceaccdb Mon Sep 17 00:00:00 2001 From: Kevin Rosenberg Date: Sun, 7 Feb 2010 21:56:42 -0700 Subject: [PATCH] Version 1.8.2: Test suite and more functions for foreign string encoding --- ChangeLog | 10 ++++ debian/changelog | 6 +++ src/i18n.lisp | 105 ++++++++++++++++++++++++++++++-------- src/package.lisp | 5 +- src/strings.lisp | 11 ++-- tests/.gitignore | 1 + tests/foreign-loader.lisp | 2 + tests/foreign-var.lisp | 6 +-- tests/i18n.lisp | 79 ++++++++++++++++++++++++++++ tests/union.lisp | 4 ++ uffi-tests.asd | 1 + 11 files changed, 197 insertions(+), 33 deletions(-) create mode 100644 tests/i18n.lisp diff --git a/ChangeLog b/ChangeLog index eba11e6..6da74a2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2010-02-07 Kevin Rosenberg + * Version 1.8.2 + * src/i18n.lisp: Rename function to + foreign-encoded-octet-count. Fix errors. + * tests/i18n.lisp: New file. i18n tests fine + on AllegroCL 8/16 bits, SBCL unicode/non-unicode, + CCL, and Lispworks 6 + * src/strings.lisp: Fix an error with decoding + strings on CCL. + 2010-02-06 Kevin Rosenberg * src/i18n.lisp: Add new function string-to-octets diff --git a/debian/changelog b/debian/changelog index 9e5a2ad..8337156 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-uffi (1.8.2-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sun, 07 Feb 2010 21:17:13 -0700 + cl-uffi (1.8.1-1) unstable; urgency=low * New upstream diff --git a/src/i18n.lisp b/src/i18n.lisp index 08c16ad..1f2bb1a 100644 --- a/src/i18n.lisp +++ b/src/i18n.lisp @@ -55,42 +55,105 @@ encoding.") (mapcar 'car *foreign-encoding-mapping*) "List of normalized names of external formats support by underlying implementation.") -(defun implementation-foreign-encoding (normalized) +(defun lookup-foreign-encoding (normalized) (cdr (assoc normalized *foreign-encoding-mapping* :test 'eql))) -(defun foreign-encoded-string-octets (str &key foreign-encoding) - "Returns the octets required to represent the string when passed to a ~ -foreign function." - ;; AllegroCL, CCL, and Lispworks give correct value without converting - ;; to external-format. CLISP, like SBCL, requires conversion with external- - ;; format - (length #+(and sbcl sb-unicode) - (sb-ext:string-to-octets - str - :external-format (or foreign-encoding - *default-foreign-encoding* - :utf-8)) - #-(and sbcl sb-unicode) str)) - -(defun string-to-octets (str &key foreign-encoding) +(defmacro string-to-octets (str &key (encoding *default-foreign-encoding*)) "Converts a Lisp string to a vector of octets." #-(or allegro lispworks openmcl sbcl) - (declare (ignore foreign-encoding)) + (declare (ignore encoding)) #-(or allegro lispworks openmcl sbcl) - (map-into (make-array len :element-type '(unsigned-byte 8)) + (map-into (make-array (length str) :element-type '(unsigned-byte 8)) #'char-code str) #+allegro - (excl:string-to-native str :external-format foreign-encoding :null-terminate nil) + (let ((fe (gensym "FE-")) + (ife (gensym "IFE-")) + (s (gensym "STR-"))) + `(let* ((,fe ,encoding) + (,ife (when ,fe (lookup-foreign-encoding ,fe))) + (,s ,str)) + (values + (if ,ife + (excl:string-to-octets ,s :external-format ,ife :null-terminate nil) + (excl:string-to-octets ,s :null-terminate nil))))) #+(or lispworks openmcl) ;; simply reading each char-code from the LENGTH of string handles multibyte characters ;; just fine in testing LW 6.0 and CCL 1.4 - (map-into (make-array len :element-type '(unsigned-byte 8)) + (map-into (make-array (length str) :element-type '(unsigned-byte 8)) #'char-code str) #+sbcl - (sb-ext:string-to-native str :external-format foreign-encoding) + (let ((fe (gensym "FE-")) + (ife (gensym "IFE-")) + (s (gensym "STR-"))) + `(let* ((,fe ,encoding) + (,ife (when ,fe (lookup-foreign-encoding ,fe))) + (,s ,str)) + (if ,ife + (sb-ext:string-to-octets ,s :external-format ,ife) + (sb-ext:string-to-octets ,s)))) ) +(defmacro octets-to-string (octets &key (encoding *default-foreign-encoding*)) + "Converts a vector of octets to a Lisp string." + #-(or allegro lispworks openmcl sbcl) + (declare (ignore encoding)) + #-(or allegro lispworks openmcl sbcl) + (let ((out (gensym "OUT-")) + (code (gensym "CODE-"))) + `(with-output-to-string (,out) + (loop for ,code across ,octets + do (write-char (code-char ,code) ,out)))) + + #+allegro + (let ((fe (gensym "FE-")) + (ife (gensym "IFE-")) + (oct (gensym "OCTETS-"))) + `(let* ((,fe ,encoding) + (,ife (when ,fe (lookup-foreign-encoding ,fe))) + (,oct ,octets)) + (values + (if ,ife + (excl:octets-to-string ,oct :external-format ,ife) + (excl:octets-to-string ,oct))))) + + #+(or lispworks openmcl) + ;; With LW 6.0 and CCL 1.4, writing multibyte character just one octet at a time tests fine + (let ((out (gensym "OUT-")) + (code (gensym "CODE-"))) + `(with-output-to-string (,out) + (loop for ,code across ,octets + do (write-char (code-char ,code) ,out)))) + + #+sbcl + (let ((fe (gensym "FE-")) + (ife (gensym "IFE-")) + (oct (gensym "OCTETS-"))) + `(let* ((,fe ,encoding) + (,ife (when ,fe (lookup-foreign-encoding ,fe))) + (,oct ,octets)) + (if ,ife + (sb-ext:octets-to-string ,oct :external-format ,ife) + (sb-ext:octets-to-string ,oct)))) + +) + +(defun foreign-encoded-octet-count (str &key (encoding *default-foreign-encoding*)) + "Returns the octets required to represent the string when passed to a ~ +foreign function." + ;; AllegroCL 8-bit, CCL, and Lispworks give correct value without converting + ;; to external-format. AllegroCL 16-bit, SBCL, and CLISP requires conversion + ;; with external-format + + #+(or (and allegro ics) (and sbcl sb-unicode) (and clisp i18n)) + (length (string-to-octets str :encoding encoding)) + + #-(or (and allegro ics) (and sbcl sb-unicode) (and clisp i18n)) + (declare (ignore encoding)) + #-(or (and allegro ics) (and sbcl sb-unicode) (and clisp i18n)) + (length str) + +) diff --git a/src/package.lisp b/src/package.lisp index 318e68a..9058093 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -85,8 +85,7 @@ #:no-i18n #:*default-foreign-encoding* #:*foreign-encodings* - #:foreign-encoded-string-octets + #:foreign-encoded-octet-count #:string-to-octets + #:octets-to-string )) - - diff --git a/src/strings.lisp b/src/strings.lisp index 2091164..eedc1b6 100644 --- a/src/strings.lisp +++ b/src/strings.lisp @@ -208,9 +208,9 @@ that LW/CMU automatically converts strings from c-calls." (defmacro convert-to-foreign-string (obj &optional foreign-encoding) #+allegro (let ((stored (gensym "STR-")) - (ef (gensym "EF-")) - (nef (gensym "NEF-"))) - `(let ((,stored ,obj) + (fe (gensym "FE-")) + (ife (gensym "IFE-"))) + `(let* ((,stored ,obj) (,fe (or foreign-encoding *default-foreign-encoding*)) (,ife (when ,fe (implementation-foreign-encoding ,fe)))) @@ -240,7 +240,7 @@ that LW/CMU automatically converts strings from c-calls." #+(or cmu scl sbcl digitool openmcl) `(%convert-to-foreign-string ,obj (implementation-foreign-encoding - (or ,foreign-encoding *default-foreign-encoding))) + (or ,foreign-encoding *default-foreign-encoding*))) ) @@ -332,8 +332,7 @@ that LW/CMU automatically converts strings from c-calls." (declare (ignore null-terminated-p)) #+(or openmcl digitool) (let ((stored-obj (gensym "STR-")) - (fe (gensym "FE-")) - (ife (gensym "IFE-"))) + (fe (gensym "FE-"))) `(let ((,stored-obj ,obj)) (if (ccl:%null-ptr-p ,stored-obj) nil diff --git a/tests/.gitignore b/tests/.gitignore index 2008a30..e911e2f 100644 --- a/tests/.gitignore +++ b/tests/.gitignore @@ -4,3 +4,4 @@ c-test-fns.dylib z.dylib .bin uffi-c-test.so +uffi-c-test.dylib diff --git a/tests/foreign-loader.lisp b/tests/foreign-loader.lisp index 017fbed..2053273 100644 --- a/tests/foreign-loader.lisp +++ b/tests/foreign-loader.lisp @@ -26,6 +26,8 @@ "z" (list (pathname-directory *load-pathname*) "/usr/local/lib/" #+(or 64bit x86-64) "/usr/lib64/" + "/usr/lib32/" + "/opt/local/lib/" "/usr/lib/" "/zlib/")) :module "zlib" :supporting-libraries '("c")) diff --git a/tests/foreign-var.lisp b/tests/foreign-var.lisp index 3a19d75..fda7c10 100644 --- a/tests/foreign-var.lisp +++ b/tests/foreign-var.lisp @@ -61,7 +61,7 @@ (fvar-struct-double)) t) -(deftest fvarst.6 +(deftest :fvarst.6 (let ((orig *fvar-addend*)) (incf *fvar-addend* 3) (prog1 @@ -69,7 +69,7 @@ (setf *fvar-addend* orig))) 6) -(deftest fvarst.7 +(deftest :fvarst.7 (let ((orig *fvar-addend*)) (incf *fvar-addend* 3) (prog1 @@ -77,7 +77,7 @@ (setf *fvar-addend* orig))) 48) -(deftest fvarst.8 +(deftest :fvarst.8 (let ((orig (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i))) (decf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 10) (prog1 diff --git a/tests/i18n.lisp b/tests/i18n.lisp new file mode 100644 index 0000000..911e41f --- /dev/null +++ b/tests/i18n.lisp @@ -0,0 +1,79 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: i18n.lisp +;;;; Purpose: UFFI test file of i18n functions +;;;; Author: Kevin M. Rosenberg +;;;; Date Started: Feb 2010 +;;;; +;;;; This file, part of UFFI, is Copyright (c) 2010 by Kevin M. Rosenberg +;;;; +;;;; ************************************************************************* + +(in-package #:uffi-tests) + +(deftest :i18n/sto/1 + (uffi:string-to-octets "") + #()) + +(deftest :i18n/sto/2 + (uffi:string-to-octets "A") + #(65)) + +(deftest :i18n/sto/3 + (uffi:string-to-octets "abc") + #(97 98 99)) + +;; Below is UTF-8 encoded, 27 octets / 20 lisp characters +(deftest :i18n/sto/4 + (uffi:string-to-octets "Iñtërnâtiônàlizætiøn" :encoding :utf-8) + #(73 195 177 116 195 171 114 110 195 162 116 105 195 180 110 195 160 108 105 122 195 166 116 105 195 184 110)) + +(deftest :i18n/sto/5 + (length (uffi:string-to-octets "Iñtërnâtiônàlizætiøn" :encoding :utf-8)) + 27) + +(deftest :i18n/feoc/1 + (uffi:foreign-encoded-octet-count "") + 0) + +(deftest :i18n/feoc/2 + (uffi:foreign-encoded-octet-count "A") + 1) + +(deftest :i18n/feoc/3 + (uffi:foreign-encoded-octet-count "abc") + 3) + +(deftest :i18n/feoc/4 + (uffi:foreign-encoded-octet-count "Iñtërnâtiônàlizætiøn" + :encoding :utf-8) + 27) + + +(deftest :i18n/ots/1 + (let ((octets '())) + (uffi:octets-to-string (make-array (list (length octets)) :element-type '(unsigned-byte 8) + :initial-contents octets))) + "") + +(deftest :i18n/ots/2 + (let ((octets '(65))) + (uffi:octets-to-string (make-array (list (length octets)) :element-type '(unsigned-byte 8) + :initial-contents octets))) + "A") + +(deftest :i18n/ots/3 + (let ((octets '(97 98 99))) + (uffi:octets-to-string (make-array (list (length octets)) :element-type '(unsigned-byte 8) + :initial-contents octets))) + "abc") + +(deftest :i18n/ots/4 + (let ((octets '(73 195 177 116 195 171 114 110 195 162 116 105 195 180 + 110 195 160 108 105 122 195 166 116 105 195 184 110))) + (uffi:octets-to-string (make-array (list (length octets)) :element-type '(unsigned-byte 8) + :initial-contents octets) + :encoding :utf-8)) + "Iñtërnâtiônàlizætiøn") diff --git a/tests/union.lisp b/tests/union.lisp index 1c7104a..f1f6b78 100644 --- a/tests/union.lisp +++ b/tests/union.lisp @@ -47,17 +47,21 @@ (deftest :union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t) +#-openmcl (uffi:def-union foo-u (bar :pointer-self)) +#-openmcl (uffi:def-foreign-type foo-u-ptr (* foo-u)) ;; tests that compilation worked +#-openmcl (deftest :unions.4 (with-foreign-object (p 'foo-u) t) t) +#-openmcl (deftest :unions.5 (progn (uffi:def-foreign-type foo-union (:union foo-u)) diff --git a/uffi-tests.asd b/uffi-tests.asd index 06577e2..ded16f7 100644 --- a/uffi-tests.asd +++ b/uffi-tests.asd @@ -86,6 +86,7 @@ (:file "compress" :depends-on ("foreign-loader")) (:file "casts" :depends-on ("foreign-loader")) (:file "foreign-var" :depends-on ("foreign-loader")) + (:file "i18n" :depends-on ("package")) )))) (defmethod perform ((o test-op) (c (eql (find-system :uffi-tests)))) -- 2.34.1