X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=40a3cb15a4a710d63bb0a607008b40071cc38afc;hb=f34346600de66d6310cc5fa3f742c4f89e05760b;hp=0a704d25ba77d689892fe44838c33da40604f2f4;hpb=3a3ccc7a171dc4c6c10bc7e3fea8461fca6dc51b;p=clsql.git diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 0a704d2..40a3cb1 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -33,7 +33,7 @@ likely that we'll have to worry about the CMUCL limit.")) (defmacro deref-vp (foreign-object) - `(uffi:deref-pointer ,foreign-object void-pointer)) + `(uffi:deref-pointer ,foreign-object :pointer-void)) ;; constants - from OCI? @@ -128,7 +128,7 @@ the length of that format.") (uffi:ensure-char-storable (code-char 0))) (setf (uffi:deref-pointer errcode :long) 0) - (oci-error-get (uffi:deref-pointer errhp void-pointer) 1 + (oci-error-get (deref-vp errhp) 1 (uffi:make-null-pointer :unsigned-char) errcode errbuf +errbuf-len+ +oci-htype-error+) (let ((subcode (uffi:deref-pointer errcode :long))) @@ -191,10 +191,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-pointer (* :unsigned-char)) +(uffi:def-type string-array (:array :unsigned-char)) (defun deref-oci-string (arrayptr string-index size) - (declare (type string-pointer arrayptr)) + (declare (type string-array arrayptr)) (declare (type (mod #.+n-buf-rows+) string-index)) (declare (type (and unsigned-byte fixnum) size)) (let* ((raw (uffi:convert-from-foreign-string @@ -226,7 +226,7 @@ the length of that format.") (flet (;; a character from OCI-DATE, interpreted as an unsigned byte (ub (i) (declare (type (mod #.+oci-date-bytes+) i)) - (mod (uffi:deref-array oci-date string-pointer i) 256))) + (mod (uffi:deref-array oci-date string-array i) 256))) (let* ((century (* (- (ub 0) 100) 100)) (year (+ century (- (ub 1) 100))) (month (ub 2)) @@ -323,7 +323,7 @@ the length of that format.") ;; STREAM which has no more data, and QC is not a STREAM, we signal ;; DBI-ERROR instead. -(uffi:def-type short-pointer '(* :short)) +(uffi:def-type short-array '(:array :short)) (uffi:def-type int-pointer '(* :int)) (uffi:def-type double-pointer '(* :double)) @@ -380,17 +380,15 @@ the length of that format.") (value (let* ((arb (foreign-resource-buffer (cd-indicators cd))) (indicator (uffi:deref-array arb '(:array :short) irow))) - (declare (type short-pointer arb)) + (declare (type short-array arb)) (unless (= indicator -1) (ecase (cd-oci-data-type cd) (#.SQLT-STR (deref-oci-string b irow (cd-sizeof cd))) (#.SQLT-FLT - (uffi:with-cast-pointer (bd b :double) - (uffi:deref-array bd '(:array :double) irow))) + (uffi:deref-array b '(:array :double) irow)) (#.SQLT-INT - (uffi:with-cast-pointer (bi b :int) - (uffi:deref-array bi '(:array :int) irow))) + (uffi:deref-array b '(:array :int) irow)) (#.SQLT-DATE (deref-oci-string b irow (cd-sizeof cd)))))))) (when (and (eq :string (cd-result-type cd)) @@ -452,7 +450,7 @@ the length of that format.") (defun sql-stmt-exec (sql-stmt-string db result-types field-names) (with-slots (envhp svchp errhp) db - (let ((stmthp (uffi:allocate-foreign-object void-pointer))) + (let ((stmthp (uffi:allocate-foreign-object :pointer-void))) (uffi:with-foreign-object (stmttype :unsigned-short) (oci-handle-alloc (deref-vp envhp) @@ -591,7 +589,7 @@ the length of that format.") (oci-attr-get (deref-vp parmdp) +oci-dtype-param+ dtype-foreign - (uffi:make-null-pointer :int) + (uffi:make-null-pointer :unsigned-int) +oci-attr-data-type+ (deref-vp errhp)) (let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short))) @@ -604,13 +602,13 @@ the length of that format.") (oci-attr-get (deref-vp parmdp) +oci-dtype-param+ precision - (uffi:make-null-pointer :int) + (uffi:make-null-pointer :unsigned-int) +oci-attr-precision+ (deref-vp errhp)) (oci-attr-get (deref-vp parmdp) +oci-dtype-param+ scale - (uffi:make-null-pointer :int) + (uffi:make-null-pointer :unsigned-int) +oci-attr-scale+ (deref-vp errhp)) (let ((*scale (uffi:deref-pointer scale :byte)) @@ -633,14 +631,14 @@ the length of that format.") (oci-attr-get (deref-vp parmdp) +oci-dtype-param+ colsize - (uffi:make-null-pointer :int) ;; (uffi:pointer-address colsizesize) + (uffi:make-null-pointer :unsigned-int) ;; (uffi:pointer-address colsizesize) +oci-attr-data-size+ (deref-vp errhp)) (let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long)))) (setf buffer (acquire-foreign-resource - :char (* +n-buf-rows+ colsize-including-null))) + :unsigned-char (* +n-buf-rows+ colsize-including-null))) (setf sizeof colsize-including-null)))) - (let ((retcodes (acquire-foreign-resource :short +n-buf-rows+)) + (let ((retcodes (acquire-foreign-resource :unsigned-short +n-buf-rows+)) (indicators (acquire-foreign-resource :short +n-buf-rows+)) (colname-string "")) (when field-names @@ -671,12 +669,15 @@ the length of that format.") defnp (deref-vp errhp) (1+ icolumn) ; OCI 1-based indexing again - (foreign-resource-buffer buffer) + (uffi:with-cast-pointer (vp (foreign-resource-buffer buffer) :void) + vp) sizeof dtype - (foreign-resource-buffer indicators) + (uffi:with-cast-pointer (vp (foreign-resource-buffer indicators) :void) + vp) (uffi:make-null-pointer :unsigned-short) - (foreign-resource-buffer retcodes) + (uffi:with-cast-pointer (vp (foreign-resource-buffer retcodes) :unsigned-short) + vp) +oci-default+)))))))) ;; Release the resources associated with a QUERY-CURSOR. @@ -740,10 +741,11 @@ the length of that format.") +oci-htype-error+ 0 +null-void-pointer-pointer+) (oci-handle-alloc (deref-vp envhp) srvhp +oci-htype-server+ 0 +null-void-pointer-pointer+) - (oci-server-attach (deref-vp srvhp) - (deref-vp errhp) - (uffi:make-null-pointer :unsigned-char) - 0 +oci-default+) + (uffi:with-cstring (dblink nil) + (oci-server-attach (deref-vp srvhp) + (deref-vp errhp) + dblink + 0 +oci-default+)) (oci-handle-alloc (deref-vp envhp) svchp +oci-htype-svcctx+ 0 +null-void-pointer-pointer+) (oci-attr-set (deref-vp svchp) @@ -757,7 +759,8 @@ the length of that format.") (uffi:with-foreign-object (buf '(:array :unsigned-char #.+errbuf-len+)) (oci-server-version (deref-vp svchp) (deref-vp errhp) - buf +errbuf-len+ +oci-htype-svcctx+) + (uffi:char-array-to-pointer buf) + +errbuf-len+ +oci-htype-svcctx+) (setf server-version (uffi:convert-from-foreign-string buf))) (setq db (make-instance 'oracle-database :name (database-name-from-spec connection-spec