Fix a handful of bugs in the PostgreSQL interface.

diff --git a/v7/src/runtime/pgsql.scm b/v7/src/runtime/pgsql.scm
index 32e42471d124212a9804ca3a084a95e5859d284e..b66f0c5cb25a769ea97818799c93a56fd2d8872d 100644 (file)
--- 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))
 \f
 (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 1bf236c43b85674a2ca1935b14b14bd6bdbbe444..c16cdb24454c7ecf223392ca7a96f9d6c02c707e 100644 (file)
--- 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