From b8e666e0f483efdec2f13eb5e1cdd0b06f700191 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Tue, 9 Nov 2004 02:29:43 +0000
Subject: [PATCH] r10141: fix for sb-unicode

---
 src/aggregates.lisp | 42 ++++++++++++++++++++++--------------------
 tests/compress.lisp | 18 ++++++++----------
 2 files changed, 30 insertions(+), 30 deletions(-)

diff --git a/src/aggregates.lisp b/src/aggregates.lisp
index aff8f77..c662407 100644
--- 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 173d3e8..7cf3cfa 100644
--- 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)
-- 
2.34.1