From: Kevin M. Rosenberg Date: Sun, 23 May 2004 05:34:30 +0000 (+0000) Subject: r9442: * sql/objects.lisp: Add database type to default database-get-type... X-Git-Tag: v3.8.6~403 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=99df5f6ad5b46a65d5698ebb85f95fa71f861da5 r9442: * 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 --- diff --git a/ChangeLog b/ChangeLog index a7ce8d0..abf4547 100644 --- 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 5e88bb1..b4467ca 100644 --- 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 aedff1b..3c6c226 100644 --- 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 fd246c9..b90a6d1 100644 --- 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 b0b5137..6ea37b6 100644 --- 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