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

diff --git a/ChangeLog b/ChangeLog
index 5c226cd1f6fa02679fc1d5233982adfebeae6979..be86ce13a65a62d924f64df4741022a7933a344f 100644 (file)
--- 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
        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.
        
 25 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * Version 2.11.1 released: Much simpler Oracle client library loading.

diff --git a/TODO b/TODO
index 867e62d6ae45f792b128b34faeabe7d339e32e2a..42f83c3fa047d39938b70322d31db30e479e5c48 100644 (file)
--- 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.
 * 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
 * :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
 
  
 * Number and Char field types
 
  

diff --git a/db-oracle/oracle-package.lisp b/db-oracle/oracle-package.lisp
index a70bfe8cc30a1607a4a60e3f890be3132000c201..07f0a552a70fcd2550ac086e4c7cc09442223fd7 100644 (file)
--- a/db-oracle/oracle-package.lisp
+++ b/db-oracle/oracle-package.lisp
@@ -17,7 +17,7 @@
 (in-package #:cl-user)
 
 (defpackage #:clsql-oracle
 (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*
   (: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 8ef460229a203916744008f860aa007f7e5b4ed8..ac8ee155cf97a3cd2665c295e034cf1f87e3ab62 100644 (file)
--- 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)))
 
               :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
 ;; 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  
                           (#.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))
                           (#.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)))
                 
               (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
                 (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))
                   (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)
                  (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 17e8ff81dbf70dfac2a521060abcccf224f4b1e1..542036fca62282dbdb1030856d49bad827c7d3d3 100644 (file)
--- 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)))
     (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
       (loop for type in raw-types
            collect
            (case type

-             ((:int :integer :tinyint :long :bigint)
+             ((:int :integer :tinyint :long)

               :int32)
               :int32)

+             (:bigint
+              :int64)

              ((:float :double)
               :double)
              ((:numeric)
              ((:float :double)
               :double)
              ((:numeric)

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index 301c37c0af89f440ac8dd135253ac9ef331a60fe..0ffe57e376db795686ba33e85fc1755a0ec03703 100644 (file)
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -24,11 +24,10 @@
        
 ;; list current tables 
 (deftest :fddl/table/1
        
 ;; 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
 
 ;; 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)
 
         (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)
 ))
 
 #.(clsql:restore-sql-reader-syntax-state)

diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index bf57c13c0d638df3767a975ca8e85251e3d9902c..a3228ab189707b62e162f451ae762785950d68b8 100644 (file)
--- a/tests/test-fdml.lisp
+++ b/tests/test-fdml.lisp
@@ -657,6 +657,7 @@
             (apply #'values (nreverse results))))))
   nil nil ("lenin@soviet.org"))
 
             (apply #'values (nreverse results))))))
   nil nil ("lenin@soviet.org"))
 

+

 ))
 
 #.(clsql:restore-sql-reader-syntax-state)
 ))
 
 #.(clsql:restore-sql-reader-syntax-state)

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 6f15d412303d28bc4cd9a055bf08806b0152899d..415af2a2b81a3c5f9b562de889f47c20a21411e5 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -176,6 +176,10 @@
                                  :set nil)))
   (:base-table "ea_join"))
 
                                  :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))
 (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)
     (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
 
   (let ((*db-auto-sync* t))
     (setf company1 (make-instance 'company


@@ -372,8 +377,11 @@
                                           :verified nil)
          employee-address5 (make-instance 'employee-address
                                           :emplid 3
                                           :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) 
     
   ;; 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 abbaddd915bf519964624cddd2dae2c310dc65e3..4898067161a9b387a840a8fb21f1a30bb75bad8a 100644 (file)
--- 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))
                 (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)
        ))
 #.(clsql:restore-sql-reader-syntax-state)

diff --git a/uffi/clsql-uffi-package.lisp b/uffi/clsql-uffi-package.lisp
index e216601240782644c3d4aa1cdef6fc2b8eb957f1..e5837a05f82bac64d9f391423dea50f5843f6d1d 100644 (file)
--- a/uffi/clsql-uffi-package.lisp
+++ b/uffi/clsql-uffi-package.lisp
@@ -28,6 +28,7 @@
    #:atof
    #:atol64
    #:make-64-bit-integer
    #:atof
    #:atol64
    #:make-64-bit-integer

+   #:make-128-bit-integer

    #:split-64-bit-integer)
   (:documentation "Common functions for interfaces using UFFI"))
 
    #:split-64-bit-integer)
   (:documentation "Common functions for interfaces using UFFI"))
 

diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp
index 63267022dc7ce8c7710b36edee0c395907ce35d8..1bb9a1a90d0b6085b4d5f3d6d754fb5b4f5e2e80 100644 (file)
--- a/uffi/clsql-uffi.lisp
+++ b/uffi/clsql-uffi.lisp
@@ -77,10 +77,17 @@
   :returning :unsigned-int)
 
 (uffi:def-constant +2^32+ 4294967296)
   :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)
 (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+)))
 
 (defmacro split-64-bit-integer (int64)
   `(values (ash ,int64 -32) (logand ,int64 +2^32-1+)))