projects
/
clsql.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r9452: * sql/sql.lisp: Honor case of string table identifier to INSERT-RECORDS
[clsql.git]
/
db-oracle
/
oracle-sql.lisp
diff --git
a/db-oracle/oracle-sql.lisp
b/db-oracle/oracle-sql.lisp
index 3598dc93f628953edad15e9c753d83d6eaa5dd16..3c6c226592edbd3d26c27ca7a69ba626320aef63 100644
(file)
--- a/
db-oracle/oracle-sql.lisp
+++ b/
db-oracle/oracle-sql.lisp
@@
-36,6
+36,13
@@
likely that we'll have to worry about the CMUCL limit."))
;; constants - from OCI?
;; constants - from OCI?
+(defvar +unsigned-char-null-pointer+
+ (uffi:make-null-pointer :unsigned-char))
+(defvar +unsigned-short-null-pointer+
+ (uffi:make-null-pointer :unsigned-short))
+(defvar +unsigned-int-null-pointer+
+ (uffi:make-null-pointer :unsigned-int))
+
(defconstant +var-not-in-list+ 1007)
(defconstant +no-data-found+ 1403)
(defconstant +null-value-returned+ 1405)
(defconstant +var-not-in-list+ 1007)
(defconstant +no-data-found+ 1403)
(defconstant +null-value-returned+ 1405)
@@
-139,9
+146,12
@@
the length of that format.")
(uffi:ensure-char-storable (code-char 0)))
(setf (uffi:deref-pointer errcode :long) 0)
(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
(let ((subcode (uffi:deref-pointer errcode :long)))
(unless (and nulls-ok (= subcode +null-value-returned+))
(error 'sql-database-error
@@
-201,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:
;; 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)
(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
(declare (type (mod #.+n-buf-rows+) string-index))
(declare (type (and unsigned-byte fixnum) size))
(let* ((raw (uffi:convert-from-foreign-string
@@
-414,7
+424,7
@@
the length of that format.")
(value
(let* ((arb (foreign-resource-buffer (cd-indicators cd)))
(indicator (uffi:deref-array arb '(:array :short) irow)))
(value
(let* ((arb (foreign-resource-buffer (cd-indicators cd)))
(indicator (uffi:deref-array arb '(:array :short) irow)))
- ;;
b
(declare (type short-array arb))
+ ;;(declare (type short-array arb))
(unless (= indicator -1)
(ecase (cd-oci-data-type cd)
(#.SQLT-STR
(unless (= indicator -1)
(ecase (cd-oci-data-type cd)
(#.SQLT-STR
@@
-454,7
+464,7
@@
the length of that format.")
(oci-attr-get (deref-vp (qc-stmthp qc))
+oci-htype-stmt+
rowcount
(oci-attr-get (deref-vp (qc-stmthp qc))
+oci-htype-stmt+
rowcount
- (uffi:make-null-pointer :unsigned-long)
+ +unsigned-int-null-pointer+
+oci-attr-row-count+
(deref-vp errhp))
(setf (qc-n-from-oci qc)
+oci-attr-row-count+
(deref-vp errhp))
(setf (qc-n-from-oci qc)
@@
-498,7
+508,7
@@
the length of that format.")
(oci-attr-get (deref-vp stmthp)
+oci-htype-stmt+
stmttype
(oci-attr-get (deref-vp stmthp)
+oci-htype-stmt+
stmttype
- (uffi:make-null-pointer :unsigned-int)
+ +unsigned-int-null-pointer+
+oci-attr-stmt-type+
(deref-vp errhp)
:database db)
+oci-attr-stmt-type+
(deref-vp errhp)
:database db)
@@
-623,7
+633,7
@@
the length of that format.")
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
dtype-foreign
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
dtype-foreign
- (uffi:make-null-pointer :unsigned-int)
+ +unsigned-int-null-pointer+
+oci-attr-data-type+
(deref-vp errhp))
(let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short)))
+oci-attr-data-type+
(deref-vp errhp))
(let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short)))
@@
-636,13
+646,13
@@
the length of that format.")
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
precision
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
precision
- (uffi:make-null-pointer :unsigned-int)
+ +unsigned-int-null-pointer+
+oci-attr-precision+
(deref-vp errhp))
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
scale
+oci-attr-precision+
(deref-vp errhp))
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
scale
- (uffi:make-null-pointer :unsigned-int)
+ +unsigned-int-null-pointer+
+oci-attr-scale+
(deref-vp errhp))
(let ((*scale (uffi:deref-pointer scale :byte))
+oci-attr-scale+
(deref-vp errhp))
(let ((*scale (uffi:deref-pointer scale :byte))
@@
-665,7
+675,7
@@
the length of that format.")
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
colsize
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
colsize
- (uffi:make-null-pointer :unsigned-int) ;; (uffi:pointer-address colsizesize)
+ +unsigned-int-null-pointer+
+oci-attr-data-size+
(deref-vp errhp))
(let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long))))
+oci-attr-data-size+
(deref-vp errhp))
(let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long))))
@@
-703,15
+713,12
@@
the length of that format.")
defnp
(deref-vp errhp)
(1+ icolumn) ; OCI 1-based indexing again
defnp
(deref-vp errhp)
(1+ icolumn) ; OCI 1-based indexing again
- (uffi:with-cast-pointer (vp (foreign-resource-buffer buffer) :void)
- vp)
+ (foreign-resource-buffer buffer)
sizeof
dtype
sizeof
dtype
- (uffi:with-cast-pointer (vp (foreign-resource-buffer indicators) :void)
- vp)
- (uffi:make-null-pointer :unsigned-short)
- (uffi:with-cast-pointer (vp (foreign-resource-buffer retcodes) :unsigned-short)
- vp)
+ (foreign-resource-buffer indicators)
+ +unsigned-short-null-pointer+
+ (foreign-resource-buffer retcodes)
+oci-default+))))))))
;; Release the resources associated with a QUERY-CURSOR.
+oci-default+))))))))
;; Release the resources associated with a QUERY-CURSOR.