(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)
+
+)
--- /dev/null
+;;;; -*- 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")
projects / uffi.git / commitdiff