CHAR to lisp type character.
* sql/generic-postgresql.lisp: (string n) => (CHAR n)
* sql/operations.lisp: Add userenv
- * doc/TODO: Add AUTOCOMMIT
+ * doc/TODO: Add AUTOCOMMIT. Remove need for large table and bigint
+ slot tests
+ * sql/oracle-sql.lisp: Add 64-bit bigint direct conversion
+ * uffi/clsql-uffi.lisp: Handle signed 64-bit integers
+ * test/test-init.lisp: Add large table with bigint slot
25 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
* Version 2.11.1 released: Much simpler Oracle client library loading.
* CACHE-TABLE-QUERIES
* Test that ":db-kind :key" adds an index for that key. This is complicated by different
backends showing autogenerated primary key in different ways.
-* Test bigint type
* :db-constraint tests
* test *db-auto-sync*
* for-each-row macro
* universal-time
* owner phrases for postgresql and oracle backends
-* test of large table with large numbers of rows, greater than 2x the number of
- rows (200) returned by the oracle backend at a time
* Number and Char field types
(in-package #:cl-user)
(defpackage #:clsql-oracle
- (:use #:common-lisp #:clsql-sys)
+ (:use #:common-lisp #:clsql-sys #:clsql-uffi)
(:export #:oracle-database
#:*oracle-server-version*
#:*oracle-so-load-path*
:unsigned-char))))
(if (string-equal str "NULL") nil str)))
+(defun deref-oci-int64 (arrayptr index)
+ (let ((low32 (uffi:deref-array arrayptr '(:array :unsigned-int)
+ (+ index index)))
+ (high32 (uffi:deref-array arrayptr '(:array :unsigned-int)
+ (+ 1 index index))))
+ (make-64-bit-integer high32 low32)))
+
+(defun deref-oci-int128 (arrayptr index)
+ (let* ((base (* 4 index))
+ (d (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base)))
+ (c (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base)))
+ (b (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base)))
+ (a (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base))))
+ (make-128-bit-integer a b c d)))
+
;; the OCI library, part Z: no-longer used logic to convert from
;; Oracle's binary date representation to Common Lisp's native date
;; representation
(#.SQLT-FLT
(uffi:deref-array b '(:array :double) irow))
(#.SQLT-INT
- (uffi:deref-array b '(:array :int) irow))
+ (ecase (cd-sizeof cd)
+ (4
+ (uffi:deref-array b '(:array :int) irow))
+ (8
+ (deref-oci-int64 b irow))
+ (16
+ (deref-oci-int128 b irow))))
(#.SQLT-DATE
(deref-oci-string b irow (cd-sizeof cd))))))))
(when (and (eq :string (cd-result-type cd))
(let ((*scale (uffi:deref-pointer scale :byte))
(*precision (uffi:deref-pointer precision :byte)))
- ;; (format t "scale=~d, precision=~d~%" *scale *precision)
+ ;;(format t "scale=~d, precision=~d~%" *scale *precision)
(cond
- ((or (and (zerop *scale) (not (zerop *precision)))
- (and (minusp *scale) (< *precision 10)))
+ ((or (and (minusp *scale) (zerop *precision))
+ (and (zerop *scale) (< 0 *precision 9)))
(setf buffer (acquire-foreign-resource :int +n-buf-rows+)
sizeof 4 ;; sizeof(int)
dtype #.SQLT-INT))
+ ((and (zerop *scale)
+ (plusp *precision)
+ #+ignore (< *precision 19))
+ (setf buffer (acquire-foreign-resource :unsigned-int
+ (* 2 +n-buf-rows+))
+ sizeof 8 ;; sizeof(int64)
+ dtype #.SQLT-INT))
+ ;; Bug in OCI? But OCI won't take 16-byte buffer for 128-bit
+ ;; integers
+ #+ignore
+ ((and (zerop *scale) (plusp *precision))
+ (setf buffer (acquire-foreign-resource :unsigned-int
+ (* 4 +n-buf-rows+))
+ sizeof 8 ;; sizeof(int128)
+ dtype #.SQLT-INT))
(t
(setf buffer (acquire-foreign-resource :double +n-buf-rows+)
sizeof 8 ;; sizeof(double)
(let ((raw-types (if (eq :auto result-types)
(loop for j from n-col below (* 2 n-col)
collect (ensure-keyword (sqlite:sqlite-aref col-names j)))
- result-types)))
+ result-types)))
(loop for type in raw-types
collect
(case type
- ((:int :integer :tinyint :long :bigint)
+ ((:int :integer :tinyint :long)
:int32)
+ (:bigint
+ :int64)
((:float :double)
:double)
((:numeric)
;; list current tables
(deftest :fddl/table/1
- (apply #'values
- (sort (mapcar #'string-downcase
- (clsql:list-tables :owner *test-database-user*))
- #'string<))
- "addr" "company" "ea_join" "employee" "type_bigint" "type_table")
+ (sort (mapcar #'string-downcase
+ (clsql:list-tables :owner *test-database-user*))
+ #'string<)
+ ("addr" "big" "company" "ea_join" "employee" "type_bigint" "type_table"))
;; create a table, test for its existence, drop it and test again
(deftest :fddl/table/2
(clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
6)
+(deftest :fddl/big/1
+ (let ((rows (clsql:select [*] :from [big] :field-names nil)))
+ (values
+ (length rows)
+ (do ((i 0 (1+ i))
+ (max (expt 2 60))
+ (rest rows (cdr rest)))
+ ((= i (length rows)) t)
+ (let ((row (car rest))
+ (index (1+ i)))
+ (unless (and (eql (first row) index)
+ (eql (second row) (truncate max index)))
+ (return nil))))))
+ 555 t)
+
+
))
#.(clsql:restore-sql-reader-syntax-state)
(apply #'values (nreverse results))))))
nil nil ("lenin@soviet.org"))
+
))
#.(clsql:restore-sql-reader-syntax-state)
:set nil)))
(:base-table "ea_join"))
+(def-view-class big ()
+ ((i :type integer :initarg :i)
+ (bi :type bigint :initarg :bi)))
+
(defun test-connect-to-database (db-type spec)
(when (clsql-sys:db-backend-has-create/destroy-db? db-type)
(ignore-errors (destroy-database spec :database-type db-type))
(clsql:create-view-from-class 'employee)
(clsql:create-view-from-class 'company)
(clsql:create-view-from-class 'address)
- (clsql:create-view-from-class 'employee-address))
+ (clsql:create-view-from-class 'employee-address)
+ (clsql:create-view-from-class 'big))
(let ((*db-auto-sync* t))
(setf company1 (make-instance 'company
:verified nil)
employee-address5 (make-instance 'employee-address
:emplid 3
- :addressid 2)
- ))
+ :addressid 2))
+
+ (let ((max (expt 2 60)))
+ (dotimes (i 555)
+ (make-instance 'big :i (1+ i) :bi (truncate max (1+ i))))))
;; sleep to ensure birthdays are no longer at current time
(sleep 1)
(every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
(mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
t t t t (1 1 2 2 2))
+
+ (deftest :oodml/big/1
+ (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
+ (values
+ (length objs)
+ (do ((i 0 (1+ i))
+ (max (expt 2 60))
+ (rest objs (cdr rest)))
+ ((= i (length objs)) t)
+ (let ((obj (car rest))
+ (index (1+ i)))
+ (unless (and (eql (slot-value obj 'i) index)
+ (eql (slot-value obj 'bi) (truncate max index)))
+ (print index)
+ (describe obj)
+ (return nil))))))
+ 555 t)
+
))
#.(clsql:restore-sql-reader-syntax-state)
#:atof
#:atol64
#:make-64-bit-integer
+ #:make-128-bit-integer
#:split-64-bit-integer)
(:documentation "Common functions for interfaces using UFFI"))
:returning :unsigned-int)
(uffi:def-constant +2^32+ 4294967296)
+(uffi:def-constant +2^64+ 18446744073709551616)
(uffi:def-constant +2^32-1+ (1- +2^32+))
(defmacro make-64-bit-integer (high32 low32)
- `(+ ,low32 (ash ,high32 32)))
+ `(if (zerop (ldb (byte 1 31) ,high32))
+ (+ ,low32 (ash ,high32 32))
+ (- (+ ,low32 (ash ,high32 32)) +2^64+)))
+
+;; From high to low ints
+(defmacro make-128-bit-integer (a b c d)
+ `(+ ,d (ash ,c 32) (ash ,b 64) (ash ,a 96)))
(defmacro split-64-bit-integer (int64)
`(values (ash ,int64 -32) (logand ,int64 +2^32-1+)))