From 645d2ea7396466b8673e3421b55e45cd327f0195 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 25 May 2004 19:06:08 +0000 Subject: [PATCH] r9482: * 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 --- ChangeLog | 6 ++++- TODO | 3 --- db-oracle/oracle-package.lisp | 2 +- db-oracle/oracle-sql.lisp | 44 +++++++++++++++++++++++++++++++---- db-sqlite/sqlite-sql.lisp | 6 +++-- tests/test-fddl.lisp | 25 ++++++++++++++++---- tests/test-fdml.lisp | 1 + tests/test-init.lisp | 14 ++++++++--- tests/test-oodml.lisp | 18 ++++++++++++++ uffi/clsql-uffi-package.lisp | 1 + uffi/clsql-uffi.lisp | 9 ++++++- 11 files changed, 109 insertions(+), 20 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5c226cd..be86ce1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -10,7 +10,11 @@ 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 * Version 2.11.1 released: Much simpler Oracle client library loading. diff --git a/TODO b/TODO index 867e62d..42f83c3 100644 --- a/TODO +++ b/TODO @@ -3,14 +3,11 @@ TESTS TO ADD * 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 diff --git a/db-oracle/oracle-package.lisp b/db-oracle/oracle-package.lisp index a70bfe8..07f0a55 100644 --- a/db-oracle/oracle-package.lisp +++ b/db-oracle/oracle-package.lisp @@ -17,7 +17,7 @@ (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* diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 8ef4602..ac8ee15 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -211,6 +211,21 @@ the length of that format.") :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 @@ -395,7 +410,13 @@ the length of that format.") (#.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)) @@ -626,13 +647,28 @@ the length of that format.") (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) diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 17e8ff8..542036f 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -145,12 +145,14 @@ (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) diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index 301c37c..0ffe57e 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -24,11 +24,10 @@ ;; 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 @@ -266,6 +265,22 @@ (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) diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index bf57c13..a3228ab 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -657,6 +657,7 @@ (apply #'values (nreverse results)))))) nil nil ("lenin@soviet.org")) + )) #.(clsql:restore-sql-reader-syntax-state) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 6f15d41..415af2a 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -176,6 +176,10 @@ :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)) @@ -229,7 +233,8 @@ (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 @@ -372,8 +377,11 @@ :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) diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index abbaddd..4898067 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -454,5 +454,23 @@ (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) diff --git a/uffi/clsql-uffi-package.lisp b/uffi/clsql-uffi-package.lisp index e216601..e5837a0 100644 --- a/uffi/clsql-uffi-package.lisp +++ b/uffi/clsql-uffi-package.lisp @@ -28,6 +28,7 @@ #:atof #:atol64 #:make-64-bit-integer + #:make-128-bit-integer #:split-64-bit-integer) (:documentation "Common functions for interfaces using UFFI")) diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index 6326702..1bb9a1a 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -77,10 +77,17 @@ :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+))) -- 2.34.1