r9442: * sql/objects.lisp: Add database type to default database-get-type...

        * sql/sql.lisp:  Add database type to default database-abort-transaction method

diff --git a/ChangeLog b/ChangeLog
index a7ce8d0772ccb7d8e9e71d9e39937b9708150049..abf454757bc199920afe7eb509c41ccfc17c92cd 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,9 @@
 22 May 2004 Kevin Rosenberg
        * Version 2.10.21 released
        * sql/classes.lisp: honor case of string tables when outputting queries 
-       
+       * sql/objects.lisp: Add database type to default database-get-type-specifier method
+       * sql/sql.lisp:  Add database type to default database-abort-transaction method
+
 22 May 2004 Kevin Rosenberg
        * Version 2.10.20 released: Oracle backend now fails 6 out of 200 tests
        * TODO: Added 2 variances from CommonSQL. Add tests for owner phrases

diff --git a/db-oracle/oracle-objects.lisp b/db-oracle/oracle-objects.lisp
index 5e88bb1933bf7dc553642d0c9c1676a52906a1e1..b4467ca0da792c26982050b40b485b9dc57c601f 100644 (file)
--- a/db-oracle/oracle-objects.lisp
+++ b/db-oracle/oracle-objects.lisp
@@ -17,8 +17,7 @@
 
 (defparameter *oracle-default-varchar2-length* "512")
 
-(defmethod database-get-type-specifier
-  (type args (database oracle-database))
+(defmethod database-get-type-specifier (type args (database oracle-database))
   (declare (ignore type args))
   (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")"))
 
@@ -28,52 +27,44 @@
              (or (first args) 38) (or (second args) 0))
     "INTEGER"))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'bigint)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'bigint)) args (database oracle-database))
   (if args
       (format nil "NUMBER(~A,~A)"
              (or (first args) 38) (or (second args) 0))
     "NUMBER(38,0)"))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'simple-base-string)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'simple-base-string)) args (database oracle-database))
   (if args
       (format nil "VARCHAR2(~A)" (car args))
     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'simple-string)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'simple-string)) args (database oracle-database))
   (if args
       (format nil "VARCHAR2(~A)" (car args))
     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'string)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'string)) args (database oracle-database))
   (if args
       (format nil "VARCHAR2(~A)" (car args))
     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'raw-string)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'raw-string)) args (database oracle-database))
   (if args
       (format nil "VARCHAR2(~A)" (car args))
     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'float)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'float)) args (database oracle-database))
   (if args
       (format nil "NUMBER(~A,~A)" (or (first args) 38) (or (second args) 38))
     "double precision"))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'long-float)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'long-float)) args (database oracle-database))
   (if args
       (format nil "NUMBER(~A,~A)"
              (or (first args) 38) (or (second args) 38))
     "double precision"))
 
-(defmethod database-get-type-specifier
-    ((type (eql 'boolean)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'boolean)) args (database oracle-database))
   (declare (ignore args))
   "CHAR(1)")
 
@@ -97,14 +88,10 @@
   (when (char-equal #\t (schar val 0))
     t))
 
-(defmethod database-get-type-specifier
-  ((type (eql 'wall-time)) args (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'wall-time)) args (database oracle-database))
   (declare (ignore args))
   "DATE")
 
-(defmethod database-get-type-specifier
-  ((type (eql 'duration))
-   args
-   (database oracle-database))
+(defmethod database-get-type-specifier ((type (eql 'duration)) args (database oracle-database))
   (declare (ignore args))
   "NUMBER(38)")

diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp
index aedff1bab29dc4cb5889f0f75cdb634f0f3e4dca..3c6c226592edbd3d26c27ca7a69ba626320aef63 100644 (file)
--- a/db-oracle/oracle-sql.lisp
+++ b/db-oracle/oracle-sql.lisp
@@ -146,9 +146,12 @@ the length of that format.")
                   (uffi:ensure-char-storable (code-char 0)))
 
              (setf (uffi:deref-pointer errcode :long) 0)
-             (oci-error-get (deref-vp errhp) 1
-                           (uffi:make-null-pointer :unsigned-char)
-                           errcode errbuf +errbuf-len+ +oci-htype-error+)
+            (uffi:with-cstring (sqlstate nil)
+              (oci-error-get (deref-vp errhp) 1
+                             sqlstate
+                             errcode
+                             (uffi:char-array-to-pointer errbuf)
+                             +errbuf-len+ +oci-htype-error+))
              (let ((subcode (uffi:deref-pointer errcode :long)))
                (unless (and nulls-ok (= subcode +null-value-returned+))
                  (error 'sql-database-error
@@ -208,10 +211,10 @@ the length of that format.")
 ;; In order to map the "same string" property above onto Lisp equality,
 ;; we drop trailing spaces in all cases:
 
-(uffi:def-type string-array (:array :unsigned-char))
+(uffi:def-type string-pointer (* :unsigned-char))
 
 (defun deref-oci-string (arrayptr string-index size)
-;;  (declare (type string-array arrayptr))
+  (declare (type string-pointer arrayptr))
   (declare (type (mod #.+n-buf-rows+) string-index))
   (declare (type (and unsigned-byte fixnum) size))
   (let* ((raw (uffi:convert-from-foreign-string 

diff --git a/sql/objects.lisp b/sql/objects.lisp
index fd246c936d0198aaed415d239f05ffa7444e4759..b90a6d1b80a8bcaeb91c930e2b266c23dd3050dd 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -499,7 +499,7 @@ strings."
            (error "No view-table for class ~A"  classname))
          (sql-expression :table (view-table class))))
 
-(defmethod database-get-type-specifier (type args database)
+(defmethod database-get-type-specifier (type args (database database))
   (declare (ignore type args))
   (if (in (database-underlying-type database)
                          :postgresql :postgresql-socket)

diff --git a/sql/transaction.lisp b/sql/transaction.lisp
index b0b5137956ef82061778d90ac821bb3e3c531902..6ea37b6b6b4bc93c065072f30ca0c4de7983726d 100644 (file)
--- a/sql/transaction.lisp
+++ b/sql/transaction.lisp
@@ -51,7 +51,7 @@
               :format-control "Cannot commit transaction against ~A because there is no transaction in progress."
               :format-arguments (list database))))
 
-(defmethod database-abort-transaction (database)
+(defmethod database-abort-transaction ((database database))
     (if (> (transaction-level database) 0)
         (when (zerop (decf (transaction-level database)))
           (unwind-protect