r10077: * multiple: Apply patch from Joerg Hoehle with multiple
authorKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 1 Oct 2004 17:02:20 +0000 (17:02 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 1 Oct 2004 17:02:20 +0000 (17:02 +0000)
        improvements.

17 files changed:
ChangeLog
clsql-mysql.asd
clsql-odbc.asd
clsql-postgresql-socket.asd
clsql-postgresql.asd
clsql-uffi.asd
db-odbc/odbc-api.lisp
db-odbc/odbc-ff-interface.lisp
db-odbc/odbc-package.lisp
db-oracle/oracle-api.lisp
db-postgresql/postgresql-api.lisp
db-postgresql/postgresql-sql.lisp
sql/conditions.lisp
sql/oodml.lisp
sql/utils.lisp
tests/utils.lisp
uffi/clsql-uffi.lisp

index a7f126c..aa3d6f3 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+01 Oct 2004 Kevin Rosenberg <kevin@rosenberg.net>
+       * multiple: Apply patch from Joerg Hoehle with multiple
+       improvements.
+       
 01 Oct 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * Version 3.0.7 released
        * sql/oodml.lisp, sql/package.lisp, db-mysql/mysql-objects.lisp:
index cbcd914..3780827 100644 (file)
@@ -72,7 +72,6 @@
 
 ;;; System definition
 
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
 (defsystem :clsql-mysql
   :name "cl-sql-mysql"
   :author "Kevin M. Rosenberg <kmr@debian.org>"
index ca2ec19..5913bed 100644 (file)
@@ -19,7 +19,6 @@
 (defpackage #:clsql-odbc-system (:use #:asdf #:cl))
 (in-package #:clsql-odbc-system)
 
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
 (defsystem clsql-odbc
   :name "clsql-odbc"
   :author "Kevin M. Rosenberg <kmr@debian.org>"
index 3862a3a..e5e1320 100644 (file)
@@ -21,7 +21,6 @@
 
 ;;; System definition
 
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
 (defsystem clsql-postgresql-socket
   :name "cl-sql-postgresql-socket"
   :author "Kevin M. Rosenberg <kmr@debian.org>"
index 81c1712..84e3606 100644 (file)
@@ -21,7 +21,6 @@
 
 #+(and allegro macosx) (push "so" excl::*load-foreign-types*)
 
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
 (defsystem clsql-postgresql
   :name "cl-sql-postgresql"
   :author "Kevin M. Rosenberg <kmr@debian.org>"
index e3aec75..ad9f93f 100644 (file)
@@ -76,7 +76,6 @@
        (and (probe-file lib)
             (> (file-write-date lib) (file-write-date (component-pathname c)))))))
   
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
 (defsystem clsql-uffi
   :name "cl-sql-base"
   :author "Kevin M. Rosenberg <kmr@debian.org>"
index 3b1beb0..eb68f20 100644 (file)
@@ -648,7 +648,6 @@ as possible second argument) to the desired representation of date/time/timestam
                   (#.$SQL_INTEGER (get-cast-int data-ptr))
                   (#.$SQL_BIGINT (read-from-string
                                   (get-cast-foreign-string data-ptr)))
-                  (#.$SQL_TINYINT (get-cast-byte data-ptr))
                   (#.$SQL_DECIMAL 
                    (let ((*read-base* 10))
                      (read-from-string (get-cast-foreign-string data-ptr))))
index 00e7cd6..a7153c8 100644 (file)
      (table-name :pointer-void)
      (table-name-length :short)
      (table-type-name :pointer-void)
-     (table-type-name-length :short))
+     (table-type-name-length :short)
+     (unique :short)
+     (reserved :short))
+  :module "odbc"
   :returning :short)
 
 
      (table-name-length :short)
      (unique :short)
      (reserved :short))
+  :module "odbc"
   :returning :short)
 
 
index 71cd96d..baedbed 100644 (file)
@@ -59,7 +59,6 @@
      #:query-database
      #:%new-statement-handle
      #:%sql-exec-direct
-     #:%put-str
      #:result-columns-count
      #:result-rows-count
      #:sql-to-c-type
index eab4c6b..1e21b81 100644 (file)
@@ -60,8 +60,6 @@
              (error 'sql-database-error :message "OCI No Data Found"))
             (#.+oci-success-with-info+
              (error 'sql-database-error :message "internal error: unexpected +oci-success-with-info"))
-            (#.+oci-no-data+
-             (error 'sql-database-error :message "OCI No Data"))
             (#.+oci-invalid-handle+
              (error 'sql-database-error :message "OCI Invalid Handle"))
             (#.+oci-need-data+
index 43b3f20..6f4908f 100644 (file)
@@ -71,6 +71,7 @@
    (dbName :cstring)
    (login :cstring)
    (pwd :cstring))
+  :module "postgresql"
   :returning pgsql-conn)
 
 (declaim (inline PQfinish))
index 2d307c2..6a8c7c8 100644 (file)
       (coerce-string user)
       (let ((connection (PQsetdbLogin host port options tty db user password)))
         (declare (type postgresql::pgsql-conn-ptr connection))
-        (unless (eq (PQstatus connection) :connection-ok)
+        (unless (eq (PQstatus connection)
+                   pgsql-conn-status-type#connection-ok)
           ;; Connect failed
           (error 'sql-connection-error
                  :database-type :postgresql
index bd36b8c..5e805e1 100644 (file)
@@ -43,10 +43,8 @@ or :ignore/nil to silently ignore the warning.")
                     :initform nil
                     :reader sql-error-database))
   (:report (lambda (c stream)
-            (format stream "A database error occurred~A: ~A / ~A~%  ~A"
-                    (if (sql-error-database c)
-                        (format nil " on database ~A" (sql-error-database c))
-                        "")
+            (format stream "A database error occurred~@[ on database ~A~]: ~A / ~A~%  ~A"
+                    (sql-error-database c)
                     (sql-error-error-id c)
                     (sql-error-secondary-error-id c)
                     (sql-error-database-message c))))
index 142e516..f3c4437 100644 (file)
@@ -1148,7 +1148,8 @@ as elements of a list."
   (unless (record-caches database)
     (setf (record-caches database)
          (make-hash-table :test 'equal
-                          #+allegro :values #+allegro :weak
+                          #+allegro   :values    #+allegro :weak
+                          #+clisp     :weak      #+clisp :value
                            #+lispworks :weak-kind #+lispworks :value)))
   (setf (gethash (compute-records-cache-key targets qualifiers)
                 (record-caches database)) results)
index a23a820..362d16c 100644 (file)
@@ -56,7 +56,9 @@
                       (symbol (symbol-name identifier))
                       (string identifier)))
          (escaped (make-string (length unescaped))))
-    (dotimes (i (length unescaped))
+    (substitute #\_ #\- unescaped)))
+
+(dotimes (i (length unescaped))
       (setf (char escaped i)
             (cond ((equal (char unescaped i) #\-)
                    #\_)
     escaped))
 
 (defmacro without-interrupts (&body body)
-  #+lispworks `(mp:without-preemption ,@body)
   #+allegro `(mp:without-scheduling ,@body)
+  #+clisp `(progn ,@body)
   #+cmu `(system:without-interrupts ,@body)
-  #+sbcl `(sb-sys::without-interrupts ,@body)
-  #+openmcl `(ccl:without-interrupts ,@body))
+  #+lispworks `(mp:without-preemption ,@body)
+  #+openmcl `(ccl:without-interrupts ,@body)
+  #+sbcl `(sb-sys::without-interrupts ,@body))
 
 (defun make-process-lock (name) 
   #+allegro (mp:make-process-lock :name name)
index 8e274d9..eb10ec3 100644 (file)
@@ -24,9 +24,8 @@
                 :type "config"))
 
 (defvar +all-db-types+
-    #-clisp '(:postgresql :postgresql-socket :mysql :sqlite :odbc :oracle
-             #+allegro :aodbc)
-    #+clisp '(:sqlite))
+  '(:postgresql :postgresql-socket :mysql :sqlite :odbc :oracle
+    #+allegro :aodbc))
 
 (defclass conn-specs ()
   ((aodbc :accessor aodbc-spec :initform nil)
index 1bb9a1a..c12f693 100644 (file)
@@ -30,7 +30,7 @@
        (nreverse new-types))
     (declare (fixnum length-types length-auto-list i))
     (if (>= i length-types)
-       (push t new-types) ;; types is shorted than num-fields
+       (push t new-types) ;; types is shorter than num-fields
        (push
         (case (nth i types)
           (:int
@@ -74,6 +74,7 @@
 (uffi:def-function "atol64"
     ((str (* :unsigned-char))
      (high32 (* :int)))
+  :module "clsql-uffi"
   :returning :unsigned-int)
 
 (uffi:def-constant +2^32+ 4294967296)
@@ -97,7 +98,7 @@
 (defun convert-raw-field (char-ptr types index &optional length)
   (declare (optimize (speed 3) (safety 0) (space 0))
           (type char-ptr-def char-ptr))
-  (let ((type (if (listp types)
+  (let ((type (if (consp types)
                  (nth index types)
                  types)))
     (cond
        (case type
         (:double
          (atof char-ptr))
-        ((or :int32 :int)
+        ((:int32 :int)
          (atoi char-ptr))
         (:int64
          (uffi:with-foreign-object (high32-ptr :int)