Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv29373 Modified Files: pg-tests.lisp v3-protocol.lisp Log Message: now COPY IN/OUT actually works, also created test-case Date: Sat Mar 20 16:48:42 2004 Author: pvaneynde Index: pg/pg-tests.lisp diff -u pg/pg-tests.lisp:1.5 pg/pg-tests.lisp:1.6 --- pg/pg-tests.lisp:1.5 Mon Mar 8 11:45:16 2004 +++ pg/pg-tests.lisp Sat Mar 20 16:48:41 2004 @@ -315,6 +315,37 @@ (when created (pg-exec conn "DROP TABLE count_test"))))))) +(defun test-copy-in-out () + (with-test-connection (conn) + (ignore-errors + (pg-exec conn "DROP TABLE foo")) + (pg-exec conn "CREATE TABLE foo (a int, b int)") + (pg-exec conn "INSERT INTO foo VALUES (1, 2)") + (pg-exec conn "INSERT INTO foo VALUES (2, 4)") + + (with-open-file (stream "/tmp/foo-out" + :direction :output + :element-type '(unsigned-byte 8) + :if-does-not-exist :create + :if-exists :overwrite) + (setf (pgcon-sql-stream conn) stream) + (pg-exec conn "COPY foo TO stdout")) + + (pg-exec conn "DELETE FROM foo") + (with-open-file (stream "/tmp/foo-out" + :direction :input + :element-type '(unsigned-byte 8) + :if-does-not-exist :error + :if-exists :overwrite) + (setf (pgcon-sql-stream conn) stream) + (pg-exec conn "COPY foo FROM stdout")) + + (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 1"))) + (assert (eql 2 (first (pg-result res :tuple 0))))) + (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 2"))) + (assert (eql 4 (first (pg-result res :tuple 0))))) + + (pg-exec conn "DROP TABLE foo"))) (defun test () (with-test-connection (conn) Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.7 pg/v3-protocol.lisp:1.8 --- pg/v3-protocol.lisp:1.7 Wed Mar 17 13:15:26 2004 +++ pg/v3-protocol.lisp Sat Mar 20 16:48:41 2004 @@ -72,7 +72,8 @@ :type base-char :reader pg-packet-type) (length :initarg :length - :type (unsigned-byte 32)) + :type (unsigned-byte 32) + :reader pg-packet-length) (data :initarg :data :type (array (unsigned-byte 8) *)) (position :initform 0 @@ -532,7 +533,7 @@ (when receive-data-p ;; we break the nice packet abstraction here to ;; get some speed: - (let ((length (read-from-packet packet :int32))) + (let ((length (- (pg-packet-length packet) 4))) (write-sequence (make-array length :element-type '(unsigned-byte 8) :displaced-to (slot-value packet