r9090: properly check for errors

[clsql.git] / db-odbc / odbc-dbi.lisp

diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp
index cc0ca084dbf69c81e090d193ed76d0f8d8a5d29b..ff96c213b3ba113e635b4befd9bef4099a7037ca 100644 (file)
--- a/db-odbc/odbc-dbi.lisp
+++ b/db-odbc/odbc-dbi.lisp
@@ -30,6 +30,7 @@
    #:disconnect
    #:end-transaction
    #:fetch-row
+   #:list-all-data-sources
    #:list-all-database-tables
    #:list-all-table-columns
    #:loop-over-results
@@ -183,6 +184,12 @@ the query against." ))
   (declare (ignore hstmt))
   (db-describe-columns db "" "" table ""))
 
+(defun list-all-data-sources ()
+  (let ((db (make-instance 'odbc-db)))
+    (unless (henv db) ;; has class allocation!
+      (setf (henv db) (%new-environment-handle)))
+    (%list-data-sources (henv db))))
+
 (defun rr-sql (hstmt sql-statement &key db)
   (declare (ignore hstmt sql-statement db))
   (warn "rr-sql not implemented."))
@@ -331,7 +338,7 @@ This makes the functions db-execute-command and db-query thread safe."
                ;;(%dispose-column-ptrs inactive-query)
                (setf column-count 0
                     width +max-precision+
-                    hstmt (%new-statement-handle hdbc)
+                    ;; KMR hstmt (%new-statement-handle hdbc)
                      (fill-pointer column-names) 0
                      (fill-pointer column-c-types) 0
                      (fill-pointer column-sql-types) 0
@@ -428,8 +435,9 @@ This makes the functions db-execute-command and db-query thread safe."
         (dotimes (col-nr count)
           (let ((data-ptr (aref column-data-ptrs col-nr))
                 (out-len-ptr (aref column-out-len-ptrs col-nr)))
-            (when data-ptr (uffi:free-foreign-object data-ptr)) ; we *did* allocate them
-            (when out-len-ptr (uffi:free-foreign-object out-len-ptr)))))
+           ;; free-statment :unbind frees these
+           #+ignore (when data-ptr (uffi:free-foreign-object data-ptr))
+           #+ignore (when out-len-ptr (uffi:free-foreign-object out-len-ptr)))))
       (cond ((null hstmt)
              nil)
             (drop-p