[pg-cvs] CVS update: pg/pg-tests.lisp pg/v3-protocol.lisp

[Peter Van Eynde]

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