r10077: * multiple: Apply patch from Joerg Hoehle with multiple

        improvements.

diff --git a/ChangeLog b/ChangeLog
index a7f126ca8255164e362ea93bc1f89815f3263de5..aa3d6f314257bfbbef9460d22339d9481963add4 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:
 01 Oct 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * Version 3.0.7 released
        * sql/oodml.lisp, sql/package.lisp, db-mysql/mysql-objects.lisp:

diff --git a/clsql-mysql.asd b/clsql-mysql.asd
index cbcd9141d17532c262fdc7e0d3574f182751ea8c..378082763c040675a8d23860eb0df24e2847e065 100644 (file)
--- a/clsql-mysql.asd
+++ b/clsql-mysql.asd
@@ -72,7 +72,6 @@
 
 ;;; System definition
 
 
 ;;; System definition
 

-#+(or allegro lispworks cmu sbcl openmcl mcl scl)

 (defsystem :clsql-mysql
   :name "cl-sql-mysql"
   :author "Kevin M. Rosenberg <kmr@debian.org>"
 (defsystem :clsql-mysql
   :name "cl-sql-mysql"
   :author "Kevin M. Rosenberg <kmr@debian.org>"

diff --git a/clsql-odbc.asd b/clsql-odbc.asd
index ca2ec199cccf1ed6359c27e74e1dc778f96d6be5..5913bede6092b975d60873a67b0a567cd7c39eff 100644 (file)
--- a/clsql-odbc.asd
+++ b/clsql-odbc.asd
@@ -19,7 +19,6 @@
 (defpackage #:clsql-odbc-system (:use #:asdf #:cl))
 (in-package #:clsql-odbc-system)
 
 (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>"
 (defsystem clsql-odbc
   :name "clsql-odbc"
   :author "Kevin M. Rosenberg <kmr@debian.org>"

diff --git a/clsql-postgresql-socket.asd b/clsql-postgresql-socket.asd
index 3862a3a2b46ac5841f465808d669ba25b69c87ca..e5e1320b52846c0f590b30f0a3b98b855b9bf190 100644 (file)
--- a/clsql-postgresql-socket.asd
+++ b/clsql-postgresql-socket.asd
@@ -21,7 +21,6 @@
 
 ;;; System definition
 
 
 ;;; 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>"
 (defsystem clsql-postgresql-socket
   :name "cl-sql-postgresql-socket"
   :author "Kevin M. Rosenberg <kmr@debian.org>"

diff --git a/clsql-postgresql.asd b/clsql-postgresql.asd
index 81c1712a4272b2779b4528de640c8c8e2c40d4e9..84e3606e80776e85b202aaea567a2071289b1fd0 100644 (file)
--- a/clsql-postgresql.asd
+++ b/clsql-postgresql.asd
@@ -21,7 +21,6 @@
 
 #+(and allegro macosx) (push "so" excl::*load-foreign-types*)
 
 
 #+(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>"
 (defsystem clsql-postgresql
   :name "cl-sql-postgresql"
   :author "Kevin M. Rosenberg <kmr@debian.org>"

diff --git a/clsql-uffi.asd b/clsql-uffi.asd
index e3aec75c16c1d076fc1bb40cba90aa01eab33911..ad9f93f47c6ec0a314f9c2ba5f59a52469f534e8 100644 (file)
--- a/clsql-uffi.asd
+++ b/clsql-uffi.asd
@@ -76,7 +76,6 @@
        (and (probe-file lib)
             (> (file-write-date lib) (file-write-date (component-pathname c)))))))
   
        (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>"
 (defsystem clsql-uffi
   :name "cl-sql-base"
   :author "Kevin M. Rosenberg <kmr@debian.org>"

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index 3b1beb0f167accde0c7917f45e51359dfa03fe48..eb68f205b42c32ce248b6f1a217c389a992f75ad 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -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_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))))
                   (#.$SQL_DECIMAL 
                    (let ((*read-base* 10))
                      (read-from-string (get-cast-foreign-string data-ptr))))

diff --git a/db-odbc/odbc-ff-interface.lisp b/db-odbc/odbc-ff-interface.lisp
index 00e7cd6f386b848e738bd23c00eaaaa1c0451f11..a7153c8660600a5d7260a967d060a6aee1cbc8ea 100644 (file)
--- a/db-odbc/odbc-ff-interface.lisp
+++ b/db-odbc/odbc-ff-interface.lisp
@@ -384,7 +384,10 @@
      (table-name :pointer-void)
      (table-name-length :short)
      (table-type-name :pointer-void)
      (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)
 
 
   :returning :short)
 
 


@@ -398,6 +401,7 @@
      (table-name-length :short)
      (unique :short)
      (reserved :short))
      (table-name-length :short)
      (unique :short)
      (reserved :short))

+  :module "odbc"

   :returning :short)
 
 
   :returning :short)
 
 

diff --git a/db-odbc/odbc-package.lisp b/db-odbc/odbc-package.lisp
index 71cd96d7efc99058ad7ced7e2504e14bf37839d8..baedbedd0c7eb6406efb8174efffeaf8a7bfcb6b 100644 (file)
--- a/db-odbc/odbc-package.lisp
+++ b/db-odbc/odbc-package.lisp
@@ -59,7 +59,6 @@
      #:query-database
      #:%new-statement-handle
      #:%sql-exec-direct
      #:query-database
      #:%new-statement-handle
      #:%sql-exec-direct

-     #:%put-str

      #:result-columns-count
      #:result-rows-count
      #:sql-to-c-type
      #:result-columns-count
      #:result-rows-count
      #:sql-to-c-type

diff --git a/db-oracle/oracle-api.lisp b/db-oracle/oracle-api.lisp
index eab4c6b3a78852a917f5cd7d95df7fcb1eb9e571..1e21b81b9d0a5849fd7ceb28fed89644fce4b85b 100644 (file)
--- a/db-oracle/oracle-api.lisp
+++ b/db-oracle/oracle-api.lisp
@@ -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"))
              (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+
             (#.+oci-invalid-handle+
              (error 'sql-database-error :message "OCI Invalid Handle"))
             (#.+oci-need-data+

diff --git a/db-postgresql/postgresql-api.lisp b/db-postgresql/postgresql-api.lisp
index 43b3f20426f7dc3f7da66091e6663f912522dfec..6f4908f0e32e99dd672a2f0415f3f8140fc0a174 100644 (file)
--- a/db-postgresql/postgresql-api.lisp
+++ b/db-postgresql/postgresql-api.lisp
@@ -71,6 +71,7 @@
    (dbName :cstring)
    (login :cstring)
    (pwd :cstring))
    (dbName :cstring)
    (login :cstring)
    (pwd :cstring))

+  :module "postgresql"

   :returning pgsql-conn)
 
 (declaim (inline PQfinish))
   :returning pgsql-conn)
 
 (declaim (inline PQfinish))

diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp
index 2d307c243f439db4848a38243618010cb718c159..6a8c7c83290c6852deff730f229e432e4b9661d8 100644 (file)
--- a/db-postgresql/postgresql-sql.lisp
+++ b/db-postgresql/postgresql-sql.lisp
@@ -428,7 +428,8 @@
       (coerce-string user)
       (let ((connection (PQsetdbLogin host port options tty db user password)))
         (declare (type postgresql::pgsql-conn-ptr connection))
       (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
           ;; Connect failed
           (error 'sql-connection-error
                  :database-type :postgresql

diff --git a/sql/conditions.lisp b/sql/conditions.lisp
index bd36b8c0ddefdf068fb125d1fa2133538682c603..5e805e172e11cc3464eafe0e261e92094cafec86 100644 (file)
--- a/sql/conditions.lisp
+++ b/sql/conditions.lisp
@@ -43,10 +43,8 @@ or :ignore/nil to silently ignore the warning.")
                     :initform nil
                     :reader sql-error-database))
   (:report (lambda (c stream)
                     :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))))
                     (sql-error-error-id c)
                     (sql-error-secondary-error-id c)
                     (sql-error-database-message c))))

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 142e51631d1f246eb19f8abb1a449d24ec0bd247..f3c4437b26504775746501ad9a76ac060320f028 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -1148,7 +1148,8 @@ as elements of a list."
   (unless (record-caches database)
     (setf (record-caches database)
          (make-hash-table :test 'equal
   (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)
                            #+lispworks :weak-kind #+lispworks :value)))
   (setf (gethash (compute-records-cache-key targets qualifiers)
                 (record-caches database)) results)

diff --git a/sql/utils.lisp b/sql/utils.lisp
index a23a820ff0231b108c92c526da089ab1e4743c01..362d16c178529ae67659996c181bbe5f2e4aac73 100644 (file)
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -56,7 +56,9 @@
                       (symbol (symbol-name identifier))
                       (string identifier)))
          (escaped (make-string (length unescaped))))
                       (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) #\-)
                    #\_)
       (setf (char escaped i)
             (cond ((equal (char unescaped i) #\-)
                    #\_)


@@ -66,11 +68,12 @@
     escaped))
 
 (defmacro without-interrupts (&body body)
     escaped))
 
 (defmacro without-interrupts (&body body)

-  #+lispworks `(mp:without-preemption ,@body)

   #+allegro `(mp:without-scheduling ,@body)
   #+allegro `(mp:without-scheduling ,@body)

+  #+clisp `(progn ,@body)

   #+cmu `(system:without-interrupts ,@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)
 
 (defun make-process-lock (name) 
   #+allegro (mp:make-process-lock :name name)

diff --git a/tests/utils.lisp b/tests/utils.lisp
index 8e274d9e40686c6be6289d4685a76115ae503a14..eb10ec33fe989ae5cd7751f0bd4a48af1ea63972 100644 (file)
--- a/tests/utils.lisp
+++ b/tests/utils.lisp
@@ -24,9 +24,8 @@
                 :type "config"))
 
 (defvar +all-db-types+
                 :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)
 
 (defclass conn-specs ()
   ((aodbc :accessor aodbc-spec :initform nil)

diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp
index 1bb9a1a90d0b6085b4d5f3d6d754fb5b4f5e2e80..c12f693368887598e3d41852d317cf446b81c288 100644 (file)
--- a/uffi/clsql-uffi.lisp
+++ b/uffi/clsql-uffi.lisp
@@ -30,7 +30,7 @@
        (nreverse new-types))
     (declare (fixnum length-types length-auto-list i))
     (if (>= i length-types)
        (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
        (push
         (case (nth i types)
           (:int


@@ -74,6 +74,7 @@
 (uffi:def-function "atol64"
     ((str (* :unsigned-char))
      (high32 (* :int)))
 (uffi:def-function "atol64"
     ((str (* :unsigned-char))
      (high32 (* :int)))

+  :module "clsql-uffi"

   :returning :unsigned-int)
 
 (uffi:def-constant +2^32+ 4294967296)
   :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))
 (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
                  (nth index types)
                  types)))
     (cond


@@ -107,7 +108,7 @@
        (case type
         (:double
          (atof char-ptr))
        (case type
         (:double
          (atof char-ptr))

-        ((or :int32 :int)
+        ((:int32 :int)

          (atoi char-ptr))
         (:int64
          (uffi:with-foreign-object (high32-ptr :int)
          (atoi char-ptr))
         (:int64
          (uffi:with-foreign-object (high32-ptr :int)