Bug in CONVERT-FROM-FOREIGN-STRING (patch included)

This is a MIME-formatted message.  If you see this text it means that your
E-mail software does not support MIME-formatted messages.

--=_yamuna.cs.ucsb.edu-733-1069183029-0001-2
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 7bit

Hi,

I found a bug in CONVERT-FROM-FOREIGN-STRING.  When called with
:LOCALE :NONE, it would call FAST-NATIVE-TO-STRING, which determines
the length of the string with strlen(), even when :LENGTH and
:NULL-TERMINATED-P NIL were given as arguments to
CONVERT-FROM-FOREIGN-STRING:

    CL-USER 1 > (lisp-implementation-type)
    "LispWorks"

    CL-USER 2 > (lisp-implementation-version)
    "4.2.7"

    CL-USER 3 > (require :uffi)

    CL-USER 4 > (uffi:convert-to-foreign-string 
    (format nil "foo~Cbar~Cbaz" #\Null #\Null))
    #<Pointer to type (:UNSIGNED :CHAR) = #x08062068>

    CL-USER 5 > (uffi:convert-from-foreign-string * :null-terminated-p nil
    :length 11 :locale none)
    "foo"

I have attached a patch, which introduces LENGTH as a second argument
to FAST-NATIVE-TO-STRING.  LENGTH can be NIL, if which case the length
is determined by strlen() as before.  I have only tested it on
LispWorks; I would appreciate it if someone could verify that the
patch also works on Allegro CL.

Thanks,
Vebjorn

--=_yamuna.cs.ucsb.edu-733-1069183029-0001-2
Content-Type: application/octet-stream
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename=patch2

--- uffi-1.4.3/src/strings.lisp~	2003-09-07 00:15:18.000000000 -0700
+++ uffi-1.4.3/src/strings.lisp	2003-11-18 10:55:44.000000000 -0800
@@ -156,7 +156,7 @@
   `(if (zerop ,obj)
        nil
      (if (eq ,locale :none)
-	 (fast-native-to-string ,obj)
+	 (fast-native-to-string ,obj ,length)
        (excl:native-to-string
 	,obj 
 	,@(when length (list :length length))
@@ -165,7 +165,7 @@
   `(if (fli:null-pointer-p ,obj)
        nil
      (if (eq ,locale :none)
-	 (fast-native-to-string ,obj)
+	 (fast-native-to-string ,obj ,length)
        (fli:convert-from-foreign-string 
 	,obj
 	,@(when length (list :length length))
@@ -311,45 +311,21 @@
 (def-type char-ptr-def (* :unsigned-char))
 
 #+(or lispworks (and allegro (not ics)))
-(defun fast-native-to-string (s)
+(defun fast-native-to-string (s len)
   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
 	   (type char-ptr-def s))
-  (let* ((len (strlen s))
-	 (str (make-string len)))
-    (declare (fixnum len)
-	     (type (simple-array (signed-byte 8) (*)) str))
+  (let* ((len (or len (strlen s)))
+         (str (make-string len)))
+    (declare (fixnum len))
+;;             (type (simple-array (signed-byte 8) (*)) str))
     (dotimes (i len str)
       (setf (aref str i) (uffi:deref-array s '(:array :char) i)))))
 
 #+(and allegro ics)
-(defun fast-native-to-string (s)
+(defun fast-native-to-string (s len)
   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
 	   (type char-ptr-def s))
-  (let* ((len (strlen s))
-	 (str (make-string len)))
-    (declare (fixnum len))
-    (dotimes (i len str)
-      (setf (schar str i) (ensure-char-character
-			  (uffi:deref-array s '(:array :char) i))))))
-
-#+ignore
-(defun fast-native-to-string (s)
-  (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0) (debug 0))
-	   (type char-ptr-def s))
-  (let* ((len (strlen s))
-	 (len4 (the fixnum (ash (the fixnum len) -2)))
-	 (end4 (the fixnum (ash (the fixnum len4) 2)))
-	 (remainder (the fixnum (- len end4)))
-	 (str (make-string len))
-	 (str4 str))
-    (declare (type fixnum len len4 end4 remainder)
-	     (type (simple-array (signed-byte 32) (*)) str4)
-	     (type (simple-array (signed-byte 8) (*)) str))
-    (dotimes (i len4)
-      (declare (fixnum i))
-      (setf (aref str4 i) (uffi:deref-array s '(:array :int) i)))
-    (dotimes (i remainder)
-      (declare (fixnum i))
-      (setf (aref str end4) (uffi:deref-array s '(:array :char) end4))
-      (incf end4))
-    str))
+  (let* ((len (or len (strlen s)))
+         (str (make-string len)))
+      (dotimes (i len str)
+        (setf (aref str i) (uffi:deref-array s '(:array :char) i)))))

--=_yamuna.cs.ucsb.edu-733-1069183029-0001-2--