From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 21 Jul 2003 00:59:52 +0000 (+0000)
Subject: Fix a handful of bugs in the PostgreSQL interface.
X-Git-Tag: 20090517-FFI~1869
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ae53c079e36df8eef2a3e28451c8ff6e2795073a;p=mit-scheme.git

Fix a handful of bugs in the PostgreSQL interface.
---

diff --git a/v7/src/runtime/pgsql.scm b/v7/src/runtime/pgsql.scm
index 32e42471d..b66f0c5cb 100644
--- a/v7/src/runtime/pgsql.scm
+++ b/v7/src/runtime/pgsql.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: pgsql.scm,v 1.1 2003/06/08 05:07:07 cph Exp $
+$Id: pgsql.scm,v 1.2 2003/07/21 00:59:45 cph Exp $
 
 Copyright 2003 Massachusetts Institute of Technology
 
@@ -78,7 +78,7 @@ USA.
   (guarantee-index-fixnum index 'INDEX->NAME)
   (if (not (fix:< index (vector-length enum)))
       (error:bad-range-argument index 'INDEX->NAME))
-  (vector-ref index enum))
+  (vector-ref enum index))
 
 (define-enum connection-status
   PGSQL-CONNECTION-OK
@@ -146,10 +146,13 @@ USA.
 	 (if (not pgsql-initialized?)
 	     (begin
 	       (set! connections (make-gc-finalizer pq-finish))
+	       (set! results (make-gc-finalizer pq-clear))
 	       (set! pgsql-initialized? #t)))
 	 #t)))
 
 (define (open-pgsql-conn parameters #!optional wait?)
+  (if (not (pgsql-available?))
+      (error "No PostgreSQL support in this sytem."))
   (let ((wait? (if (default-object? wait?) #t wait?)))
     (make-gc-finalized-object
      connections
@@ -208,7 +211,7 @@ USA.
 (define-connection-accessor error-message)
 
 (define (pgsql-conn-status connection)
-  (index->name (connection->handle connection) connection-status))
+  (index->name (pq-status (connection->handle connection)) connection-status))
 
 (define (escape-pgsql-string string)
   (let ((escaped (make-string (fix:* 2 (string-length string)))))
@@ -251,15 +254,17 @@ USA.
 	      (,(symbol-append 'PQ- field) (RESULT->HANDLE OBJECT))))
 	 (ill-formed-syntax form)))))
 
-(define-result-accessor result-status)
 (define-result-accessor result-error-message)
 (define-result-accessor clear)
 (define-result-accessor n-tuples)
 (define-result-accessor n-fields)
 (define-result-accessor cmd-status)
 
-(define (pgsql-res-status status)
-  (pq-res-status status))
+(define (pgsql-result-status result)
+  (index->name (pq-result-status (result->handle result)) exec-status))
+
+(define (pgsql-result-status-string result)
+  (pq-res-status (pq-result-status (result->handle result))))
 
 (define (pgsql-field-name result index)
   (pq-field-name (result->handle result) index))
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 1bf236c43..c16cdb244 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.448 2003/07/09 04:27:03 cph Exp $
+$Id: runtime.pkg,v 14.449 2003/07/21 00:59:52 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -4655,9 +4655,9 @@ USA.
 	  pgsql-polling-ok
 	  pgsql-polling-reading
 	  pgsql-polling-writing
-	  pgsql-res-status
 	  pgsql-result-error-message
 	  pgsql-result-status
+	  pgsql-result-status-string
 	  pgsql-tuples-ok
 	  poll-pgsql-conn
 	  poll-pgsql-reset))
\ No newline at end of file