r10141: fix for sb-unicode

diff --git a/src/aggregates.lisp b/src/aggregates.lisp
index aff8f7740dcbf502106fc465c08a31e29e874361..c6624074dd2a07baeaa46bbad95da468bd32ef89 100644 (file)
--- a/src/aggregates.lisp
+++ b/src/aggregates.lisp
@@ -227,25 +227,27 @@ of the enum-name name, separator-string, and field-name"
       (setf (aref a i) (uffi:deref-array s '(:array :unsigned-byte) i)))))
 
 #+sbcl
-(defun convert-from-foreign-usb8 (sap len)
-  (declare (type sb-sys:system-area-pointer sap))
-  (locally
-      (declare (optimize (speed 3) (safety 0)))
-    (let ((result (make-array len :element-type '(unsigned-byte 8))))
-      (sb-kernel:copy-from-system-area sap 0
-                                      result (* sb-vm:vector-data-offset
-                                                sb-vm:n-word-bits)
-                                      (* len sb-vm:n-byte-bits))
-      result)))
+(defun convert-from-foreign-usb8 (s len)
+  (let ((sap (sb-alien:alien-sap s)))
+    (declare (type sb-sys:system-area-pointer sap))
+    (locally
+       (declare (optimize (speed 3) (safety 0)))
+      (let ((result (make-array len :element-type '(unsigned-byte 8))))
+       (sb-kernel:copy-from-system-area sap 0
+                                        result (* sb-vm:vector-data-offset
+                                                  sb-vm:n-word-bits)
+                                        (* len sb-vm:n-byte-bits))
+       result))))
 
 #+cmu
-(defun convert-from-foreign-usb8 (sap len)
-  (declare (type system:system-area-pointer sap))
-  (locally
-      (declare (optimize (speed 3) (safety 0)))
-    (let ((result (make-array len :element-type '(unsigned-byte 8))))
-      (kernel:copy-from-system-area sap 0
-                                   result (* vm:vector-data-offset
-                                             vm:word-bits)
-                                   (* len vm:byte-bits))
-      result)))
+(defun convert-from-foreign-usb8 (s len)
+  (let ((sap (alien:alien-sap s)))
+    (declare (type system:system-area-pointer sap))
+    (locally
+       (declare (optimize (speed 3) (safety 0)))
+      (let ((result (make-array len :element-type '(unsigned-byte 8))))
+       (kernel:copy-from-system-area sap 0
+                                     result (* vm:vector-data-offset
+                                               vm:word-bits)
+                                     (* len vm:byte-bits))
+       result))))

diff --git a/tests/compress.lisp b/tests/compress.lisp
index 173d3e8f076316aef9b309278632d620e964e24a..7cf3cfa26f499f72de46f47fb6f1abc60079095d 100644 (file)
--- a/tests/compress.lisp
+++ b/tests/compress.lisp
@@ -36,10 +36,8 @@
            (newdestlen (uffi:deref-pointer destlen :long)))
        (unwind-protect
            (if (zerop result)
-               (values (uffi:convert-from-foreign-string 
-                        dest
-                        :length newdestlen
-                        :null-terminated-p nil)
+               (values (uffi:convert-from-foreign-usb8 
+                        dest newdestlen)
                        newdestlen)
              (error "zlib error, code ~D" result))
          (progn
@@ -74,12 +72,12 @@
            (uffi:free-foreign-object destlen)
            (uffi:free-foreign-object dest)))))))
 
-(deftest compress.1 (map 'list #'char-code (compress ""))
-  (120 156 3 0 0 0 0 1))
-(deftest compress.2 (map 'list #'char-code  (compress "test"))
-  (120 156 43 73 45 46 1 0 4 93 1 193))
-(deftest compress.3 (map 'list #'char-code (compress "test2"))
-  (120 156 43 73 45 46 49 2 0 6 80 1 243))
+(deftest compress.1 (compress "")
+  #(120 156 3 0 0 0 0 1) 8)
+(deftest compress.2  (compress "test")
+  #(120 156 43 73 45 46 1 0 4 93 1 193) 12)
+(deftest compress.3 (compress "test2")
+  #(120 156 43 73 45 46 49 2 0 6 80 1 243) 13)
 
 (defun compress-uncompress (str)
   (multiple-value-bind (compressed len) (compress str)