improvements.
+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:
;;; System definition
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
(defsystem :clsql-mysql
:name "cl-sql-mysql"
:author "Kevin M. Rosenberg <kmr@debian.org>"
(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>"
;;; 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>"
#+(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>"
(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>"
(#.$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))))
(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)
#:query-database
#:%new-statement-handle
#:%sql-exec-direct
- #:%put-str
#:result-columns-count
#:result-rows-count
#:sql-to-c-type
(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+
(dbName :cstring)
(login :cstring)
(pwd :cstring))
+ :module "postgresql"
:returning pgsql-conn)
(declaim (inline PQfinish))
(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
: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))))
(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)
(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)
: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)
(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
(uffi:def-function "atol64"
((str (* :unsigned-char))
(high32 (* :int)))
+ :module "clsql-uffi"
:returning :unsigned-int)
(uffi:def-constant +2^32+ 4294967296)
(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)