Update of /project/pg/cvsroot/pg
In directory common-lisp.net:/tmp/cvs-serv17791
Modified Files:
pg.asd sysdep.lisp v3-protocol.lisp
Log Message:
Modified sbcl unicode support, works for me.
Moved requires into asdf package, otherwise we get asdf package problems, unknown if it works with other lisps
Date: Tue Oct 18 15:07:27 2005
Author: pvaneynde
Index: pg/pg.asd
diff -u pg/pg.asd:1.7 pg/pg.asd:1.8
--- pg/pg.asd:1.7 Sun Jul 17 17:44:48 2005
+++ pg/pg.asd Tue Oct 18 15:07:27 2005
@@ -16,6 +16,12 @@
:name "Socket-level PostgreSQL interface"
:author "Eric Marsden"
:version "0.22"
+ :depends-on (
+ #+allegro :socket
+ #+lispworks "comm"
+ #+cormanlisp :sockets
+ #+sbcl :sb-bsd-sockets
+ #+(and mcl (not openmcl)) "OPENTRANSPORT")
:components ((:file "md5")
(:file "defpackage" :depends-on ("md5"))
(:pg-component "sysdep" :depends-on ("defpackage" "md5"))
Index: pg/sysdep.lisp
diff -u pg/sysdep.lisp:1.9 pg/sysdep.lisp:1.10
--- pg/sysdep.lisp:1.9 Sun Jul 17 17:46:32 2005
+++ pg/sysdep.lisp Tue Oct 18 15:07:27 2005
@@ -7,13 +7,6 @@
(in-package :postgresql)
-(eval-when (:compile-toplevel :load-toplevel :execute)
- #+allegro (require :socket)
- #+lispworks (require "comm")
- #+cormanlisp (require :sockets)
- #+sbcl (require :sb-bsd-sockets)
- #+(and mcl (not openmcl)) (require "OPENTRANSPORT"))
-
(defmacro %sysdep (desc &rest forms)
(when (null forms)
@@ -336,7 +329,8 @@
#+(and allegro ics)
(excl:octets-to-string bytes :external-format encoding)
#+(and :sbcl :sb-unicode)
- (sb-ext:octets-to-string bytes :external-format encoding)
+ (sb-ext:octets-to-string bytes :external-format
+ (sbcl-ext-form-from-client-encoding encoding))
;; for implementations that have no support for character
;; encoding, we assume that the encoding is an octet-for-octet
;; encoding, and convert directly
Index: pg/v3-protocol.lisp
diff -u pg/v3-protocol.lisp:1.17 pg/v3-protocol.lisp:1.18
--- pg/v3-protocol.lisp:1.17 Sun Jul 17 17:48:06 2005
+++ pg/v3-protocol.lisp Tue Oct 18 15:07:27 2005
@@ -274,18 +274,10 @@
(when (< length 0)
(error "length cannot be negative. is: ~S"
length))
- (let ((result (make-array length
- :element-type 'base-char)))
- (with-slots (data position)
- packet
- (loop :for i :from 0 :below length
- :do
- (setf (elt result i)
- (code-char
- (the (unsigned-byte 8)
- (elt data (+ i position))))))
- (incf position length)
- result))))
+ (let* ((octects (read-octets-from-packet packet
+ length))
+ (string (convert-string-from-bytes octects)))
+ string)))
(defmethod read-octets-from-packet ((packet pg-packet) (length integer))
(let ((result (make-array length :element-type '(unsigned-byte 8))))
