r9388: * db-oracle/oracle-api: Add OCIServerVersion

        * db-oracle/oracle-sql: Query and store server version on connect
        * sql/db-interface.lisp: Add new db-type-has-bigint? generic
        function to handle OCI's lack of bigint support
        * test/test-basic.lisp: Separate bigint testing
        * test/test-utils.lisp: Add oracle to specs and list of backends

diff --git a/ChangeLog b/ChangeLog
index 322ab28eeedaca9444cc3285ea3ef53f0e811e6d..dbba7866653112f12ddd5a2589d39226f87d26c7 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,9 @@
 16 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
 16 May 2004 Kevin Rosenberg (kevin@rosenberg.net)

+       * db-oracle/oracle-api: Add OCIServerVersion
+       * db-oracle/oracle-sql: Query and store server version on connect
+       * sql/db-interface.lisp: Add new db-type-has-bigint? generic
+       function to handle OCI's lack of bigint support
+       * test/test-basic.lisp: Separate bigint testing

        * test/test-utils.lisp: Add oracle to specs and list of backends
        * doc/TODO: New file
        * test/test-fdml.lisp: Added FDML/SELECT/34 to test
        * test/test-utils.lisp: Add oracle to specs and list of backends
        * doc/TODO: New file
        * test/test-fdml.lisp: Added FDML/SELECT/34 to test

diff --git a/db-oracle/make.sh b/db-oracle/make.sh
index ebed3a53b081a44300a0504ab5446383a29565b0..ca5353e650436dfda76e92b3904e12c18ce7efa4 100755 (executable)
--- a/db-oracle/make.sh
+++ b/db-oracle/make.sh
@@ -1,5 +1,5 @@
 if [ -z "$ORACLE_HOME" ]; then 
 if [ -z "$ORACLE_HOME" ]; then 

-  ORACLE_HOME=/opt/10g/product/10.1.0/db_1
+  ORACLE_HOME=/10g/app/product/10.1.0/db_1

 fi
 
 EMPTY_LIBS=-lclntst10
 fi
 
 EMPTY_LIBS=-lclntst10

diff --git a/db-oracle/oracle-api.lisp b/db-oracle/oracle-api.lisp
index 96b8e168cd80a746235516cca884a43903f683e8..debded7a3e7229fdb99874242c47a39e286d0fd4 100644 (file)
--- a/db-oracle/oracle-api.lisp
+++ b/db-oracle/oracle-api.lisp
@@ -297,7 +297,15 @@
   (p2           :unsigned-short))
 
 
   (p2           :unsigned-short))
 
 

+(def-oci-routine ("OCIServerVersion" oci-server-version)
+    :int
+    (handlp    (* :void))
+    (errhp     (* :void))
+    (bufp      (* :unsigned-char))
+    (bufsz     :int)
+    (hndltype  :short))

 
 

+               

 ;;; Functions
 
 (defun oci-init (&key (mode +oci-default+))
 ;;; Functions
 
 (defun oci-init (&key (mode +oci-default+))

diff --git a/db-oracle/oracle-objects.lisp b/db-oracle/oracle-objects.lisp
index 6740f94bddfcc625a5828362c9b12bf98db0f320..84a352cba819c6f99619f004e42874ecd763c811 100644 (file)
--- a/db-oracle/oracle-objects.lisp
+++ b/db-oracle/oracle-objects.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; Name:          oracle-objects.lisp
+;;;; Name: oracle-objects.lisp

 ;;;;
 ;;;; $Id$
 ;;;;
 ;;;;
 ;;;; $Id$
 ;;;;


@@ -69,6 +69,11 @@
              (or (first args) 38) (or (second args) 38))
     "NUMBER"))
 
              (or (first args) 38) (or (second args) 38))
     "NUMBER"))
 

+(defmethod database-get-type-specifier
+    ((type (eql 'boolean)) args (database oracle-database))
+  (declare (ignore args))
+  "CHAR(1)")
+

 (defmethod read-sql-value (val type (database oracle-database))
   ;;(format t "value is \"~A\" of type ~A~%" val (type-of val))
   (declare (ignore type))
 (defmethod read-sql-value (val type (database oracle-database))
   ;;(format t "value is \"~A\" of type ~A~%" val (type-of val))
   (declare (ignore type))


@@ -89,16 +94,17 @@
 (defmethod read-sql-value (val (type (eql 'float)) (database oracle-database))
   val)
 
 (defmethod read-sql-value (val (type (eql 'float)) (database oracle-database))
   val)
 

-;;; LOCAL-TIME stuff that needs to go into hooks
-#+local-time
-(defmethod clsql::database-get-type-specifier
-  ((type (eql 'local-time::local-time)) args (database oracle-database))
+(defmethod read-sql-value (val (type (eql 'boolean)) (database oracle-database))
+  (when (char-equal #\t (schar val 0))
+    t))
+
+(defmethod database-get-type-specifier
+  ((type (eql 'wall-time)) args (database oracle-database))

   (declare (ignore args))
   "DATE")
 
   (declare (ignore args))
   "DATE")
 

-#+local-time
-(defmethod clsql::database-get-type-specifier
-  ((type (eql 'local-time::duration))
+(defmethod database-get-type-specifier
+  ((type (eql 'duration))

    args
    (database oracle-database))
   (declare (ignore args))
    args
    (database oracle-database))
   (declare (ignore args))

diff --git a/db-oracle/oracle-package.lisp b/db-oracle/oracle-package.lisp
index 41f174b6bcd2d6ee12ad11cc1dcb9cee949c1d17..a70bfe8cc30a1607a4a60e3f890be3132000c201 100644 (file)
--- a/db-oracle/oracle-package.lisp
+++ b/db-oracle/oracle-package.lisp
@@ -19,6 +19,7 @@
 (defpackage #:clsql-oracle
   (:use #:common-lisp #:clsql-sys)
   (:export #:oracle-database
 (defpackage #:clsql-oracle
   (:use #:common-lisp #:clsql-sys)
   (:export #:oracle-database

+          #:*oracle-server-version*

           #:*oracle-so-load-path*
           #:*oracle-so-libraries*)
   (:documentation "This is the CLSQL interface to Oracle."))
           #:*oracle-so-load-path*
           #:*oracle-so-libraries*)
   (:documentation "This is the CLSQL interface to Oracle."))

diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp
index d5ed576e38812523e0e86600f9bd276590c3c174..ebd7e8cb1f54887ac9900ae0cc1fcbee1e45a0b6 100644 (file)
--- a/db-oracle/oracle-sql.lisp
+++ b/db-oracle/oracle-sql.lisp
@@ -15,6 +15,9 @@
 
 (in-package #:clsql-oracle)
 
 
 (in-package #:clsql-oracle)
 

+(defvar *oracle-server-version* nil
+  "Version string of Oracle server.")
+

 (defmethod database-initialize-database-type
     ((database-type (eql :oracle)))
   t)
 (defmethod database-initialize-database-type
     ((database-type (eql :oracle)))
   t)


@@ -255,19 +258,17 @@ the length of that format.")))
 ;  (sql:query "select '',OWNER,TABLE_NAME,TABLE_TYPE,'' from all_catalog"))
   
 
 ;  (sql:query "select '',OWNER,TABLE_NAME,TABLE_TYPE,'' from all_catalog"))
   
 

-(defmethod list-all-user-database-tables ((db oracle-database))
-  (unless db
-    (setf db clsql:*default-database*))
+(defmethod database-list-tables ((db oracle-database) &key owner)

   (values (database-query "select TABLE_NAME from all_catalog
   (values (database-query "select TABLE_NAME from all_catalog

-               where owner <> 'PUBLIC' and owner <> 'SYSTEM' and owner <> 'SYS'"
+               where owner not in ('PUBLIC','SYSTEM','SYS','WMSYS','EXFSYS','CTXSYS','WKSYS','WK_TEST','MDSYS','DMSYS','OLAPSYS','ORDSYS','XDB')"

                          db nil nil)))
 
 
                          db nil nil)))
 
 

-(defmethod database-list-tables ((database oracle-database)
+(defmethod database-list-views ((database oracle-database)

                                  &key (system-tables nil) owner)
   (if system-tables
       (database-query "select table_name from all_catalog" database nil nil)
                                  &key (system-tables nil) owner)
   (if system-tables
       (database-query "select table_name from all_catalog" database nil nil)

-    (database-query "select table_name from all_catalog where owner <> 'PUBLIC' and owner <> 'SYSTEM' and owner <> 'SYS'"
+    (database-query "select table_name from all_catalog where owner != 'PUBLIC' and owner != 'SYSTEM' and owner != 'SYS'"

                    database nil nil)))
 
 ;; Return a list of all columns in TABLE.
                    database nil nil)))
 
 ;; Return a list of all columns in TABLE.


@@ -310,7 +311,7 @@ the length of that format.")))
     (mapcar #'car
            (database-query
             (format nil
     (mapcar #'car
            (database-query
             (format nil

-                    "select user_tab_columns,column_name from user_tab_columns where user_tab_columns.table_name=~A"
+                    "select user_tab_columns,column_name from user_tab_columns where user_tab_columns.table_name='~A'"

                     relname)
             database nil nil))))
 
                     relname)
             database nil nil))))
 


@@ -564,7 +565,7 @@ the length of that format.")))
     database
     (unless (eq types :auto)
       (error "unsupported TYPES value"))
     database
     (unless (eq types :auto)
       (error "unsupported TYPES value"))

-    (uffi:with-foreign-objects ((dtype :unsigned-short)
+    (uffi:with-foreign-objects ((dtype-foreign :unsigned-short)

                           (parmdp (* :void))
                           (precision :byte)
                           (scale :byte)
                           (parmdp (* :void))
                           (precision :byte)
                           (scale :byte)


@@ -588,65 +589,66 @@ the length of that format.")))
          ;; handle in Lisp.
          (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
                        +oci-dtype-param+ 
          ;; handle in Lisp.
          (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
                        +oci-dtype-param+ 

-                       dtype
+                       dtype-foreign

                        (uffi:make-null-pointer :int) +oci-attr-data-type+
                        (uffi:deref-pointer errhp void-pointer))
                        (uffi:make-null-pointer :int) +oci-attr-data-type+
                        (uffi:deref-pointer errhp void-pointer))

-         (case dtype
-           (#.SQLT-DATE
-            (setf buffer (acquire-foreign-resource :char (* 32 +n-buf-rows+)))
-            (setf sizeof 32 dtype #.SQLT-STR))
-           (2 ;; number
-            ;;(oci-attr-get parmdp +oci-dtype-param+
-            ;;(addr precision) nil +oci-attr-precision+
-            ;;(uffi:deref-pointer errhp))
-            (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
-                          +oci-dtype-param+
-                          scale
-                          (uffi:make-null-pointer :int) +oci-attr-scale+
-                          (uffi:deref-pointer errhp void-pointer))
-            (cond
-             ((zerop scale)
-              (setf buffer (acquire-foreign-resource :init +n-buf-rows+)
-                    sizeof 4                   ;; sizeof(int)
-                    dtype #.SQLT-INT))
-             (t
-              (setf buffer (acquire-foreign-resource :double +n-buf-rows+)
-                    sizeof 8                   ;; sizeof(double)
-                    dtype #.SQLT-FLT))))          
-           (t  ; Default to SQL-STR
-            (setf (uffi:deref-pointer colsize :unsigned-long) 0
-                  dtype #.SQLT-STR)
-            (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
-                          +oci-dtype-param+ 
-                          colsize
-                          (uffi:make-null-pointer :int) ;;  (uffi:pointer-address colsizesize) 
-                          +oci-attr-data-size+
-                          (uffi:deref-pointer errhp void-pointer))
-            (let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long))))
-              (setf buffer (acquire-foreign-resource
-                            :char (* +n-buf-rows+ colsize-including-null)))
-              (setf sizeof colsize-including-null))))
-         (let ((retcodes (acquire-foreign-resource :short +n-buf-rows+))
-               (indicators (acquire-foreign-resource :short +n-buf-rows+)))
-           (push (make-cd :name "col" ;(subseq colname 0 colnamelen)
-                          :sizeof sizeof
-                          :buffer buffer
-                          :oci-data-type dtype
-                          :retcodes retcodes
-                          :indicators indicators)
-                 cds-as-reversed-list)
-           (oci-define-by-pos (uffi:deref-pointer stmthp void-pointer)
-                              defnp
-                              (uffi:deref-pointer errhp void-pointer)
-                              (1+ icolumn) ; OCI 1-based indexing again
-                              (foreign-resource-buffer buffer)
-                              sizeof
-                              dtype
-                              (foreign-resource-buffer indicators)
-                              (uffi:make-null-pointer :unsigned-short)
-                              (foreign-resource-buffer retcodes)
-                              +oci-default+)))))))
-
+         (let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short)))
+           (case dtype
+             (#.SQLT-DATE
+              (setf buffer (acquire-foreign-resource :char (* 32 +n-buf-rows+)))
+              (setf sizeof 32 dtype #.SQLT-STR))
+             (2 ;; number
+              ;;(oci-attr-get parmdp +oci-dtype-param+
+              ;;(addr precision) nil +oci-attr-precision+
+              ;;(uffi:deref-pointer errhp))
+              (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
+                            +oci-dtype-param+
+                            scale
+                            (uffi:make-null-pointer :int) +oci-attr-scale+
+                            (uffi:deref-pointer errhp void-pointer))
+              (cond
+               ((zerop scale)
+                (setf buffer (acquire-foreign-resource :init +n-buf-rows+)
+                      sizeof 4                 ;; sizeof(int)
+                      dtype #.SQLT-INT))
+               (t
+                (setf buffer (acquire-foreign-resource :double +n-buf-rows+)
+                      sizeof 8                   ;; sizeof(double)
+                      dtype #.SQLT-FLT))))          
+             (t                        ; Default to SQL-STR
+              (setf (uffi:deref-pointer colsize :unsigned-long) 0
+                    dtype #.SQLT-STR)
+              (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
+                            +oci-dtype-param+ 
+                            colsize
+                            (uffi:make-null-pointer :int) ;;  (uffi:pointer-address colsizesize) 
+                            +oci-attr-data-size+
+                            (uffi:deref-pointer errhp void-pointer))
+              (let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long))))
+                (setf buffer (acquire-foreign-resource
+                              :char (* +n-buf-rows+ colsize-including-null)))
+                (setf sizeof colsize-including-null))))
+           (let ((retcodes (acquire-foreign-resource :short +n-buf-rows+))
+                 (indicators (acquire-foreign-resource :short +n-buf-rows+)))
+             (push (make-cd :name "col" ;(subseq colname 0 colnamelen)
+                            :sizeof sizeof
+                            :buffer buffer
+                            :oci-data-type dtype
+                            :retcodes retcodes
+                            :indicators indicators)
+                   cds-as-reversed-list)
+             (oci-define-by-pos (uffi:deref-pointer stmthp void-pointer)
+                                defnp
+                                (uffi:deref-pointer errhp void-pointer)
+                                (1+ icolumn) ; OCI 1-based indexing again
+                                (foreign-resource-buffer buffer)
+                                sizeof
+                                dtype
+                                (foreign-resource-buffer indicators)
+                                (uffi:make-null-pointer :unsigned-short)
+                                (foreign-resource-buffer retcodes)
+                                +oci-default+))))))))
+  

 ;; Release the resources associated with a QUERY-CURSOR.
 
 (defun close-query (qc)
 ;; Release the resources associated with a QUERY-CURSOR.
 
 (defun close-query (qc)


@@ -735,6 +737,14 @@ the length of that format.")))
                   (uffi:convert-to-cstring data-source-name) (length data-source-name)
                   :database db)
        ;; :date-format-length (1+ (length date-format)))))
                   (uffi:convert-to-cstring data-source-name) (length data-source-name)
                   :database db)
        ;; :date-format-length (1+ (length date-format)))))

+       (uffi:with-foreign-object (buf (:array :unsigned-char 512))
+         (oci-server-version (uffi:deref-pointer svchp void-pointer)
+                             (uffi:deref-pointer errhp void-pointer)
+                             buf
+                             512
+                             +oci-htype-svcctx+)
+         (setf *oracle-server-version* (uffi:convert-from-foreign-string buf)))
+       

        (setf (slot-value db 'clsql-sys::state) :open)
         (database-execute-command
         (format nil "alter session set NLS_DATE_FORMAT='~A'" (date-format db)) db)
        (setf (slot-value db 'clsql-sys::state) :open)
         (database-execute-command
         (format nil "alter session set NLS_DATE_FORMAT='~A'" (date-format db)) db)


@@ -910,3 +920,7 @@ the length of that format.")))
       buf)))
 
 
       buf)))
 
 

+;; Specifications
+
+(defmethod db-type-has-bigint? ((type (eql :oracle)))
+  nil)

diff --git a/sql/db-interface.lisp b/sql/db-interface.lisp
index 62436309b25e550bf877a09f493c4e65d74bafdc..64841728855094f6461f77a9c03a4d4ab4f5b805 100644 (file)
--- a/sql/db-interface.lisp
+++ b/sql/db-interface.lisp
@@ -218,6 +218,13 @@ of TYPE_NAME (keyword) PRECISION SCALE NULLABLE."))
           t)
   (:documentation "T [default] if database-type supports views."))
 
           t)
   (:documentation "T [default] if database-type supports views."))
 

+(defgeneric db-type-has-bigint? (db-type)
+  (:method (db-type)
+          (declare (ignore db-type))
+          ;; SQL92 has bigint
+          t)
+  (:documentation "T [default] if database-type supports bigint."))
+

 (defgeneric db-type-default-case (db-type)
   (:method (db-type)
           (declare (ignore db-type))
 (defgeneric db-type-default-case (db-type)
   (:method (db-type)
           (declare (ignore db-type))

diff --git a/sql/package.lisp b/sql/package.lisp
index cb6c2de6ec2dc00768808cd2cc4930a241586471..492fbfdd610ea4a599f3614b6ee28bf7fdc486c5 100644 (file)
--- a/sql/package.lisp
+++ b/sql/package.lisp
@@ -136,6 +136,7 @@
      
      #:db-backend-has-create/destroy-db?
      #:db-type-has-views?
      
      #:db-backend-has-create/destroy-db?
      #:db-type-has-views?

+     #:db-type-has-bigint?

      #:db-type-has-union?
      #:db-type-has-subqueries?
      #:db-type-has-boolean-where?
      #:db-type-has-union?
      #:db-type-has-subqueries?
      #:db-type-has-boolean-where?

diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp
index 598879bd1aca96e01aa2e1eb0b498de7979d0fe1..bdf671f2c62e455aa1d8abc32592cb00f1de5ba5 100644 (file)
--- a/tests/test-basic.lisp
+++ b/tests/test-basic.lisp
@@ -18,48 +18,24 @@
 
 (in-package #:clsql-tests)
 
 
 (in-package #:clsql-tests)
 

-(defun test-basic-initialize ()
-  (ignore-errors
-   (clsql:execute-command "DROP TABLE TYPE_TABLE"))
-  (clsql:execute-command 
-   "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_bigint BIGINT, t_str VARCHAR(30))")
-  (dotimes (i 11)
-    (let* ((test-int (- i 5))
-          (test-flt (transform-float-1 test-int)))
-      (clsql:execute-command
-       (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,~a,'~a')"
-              test-int
-              (clsql-sys:number-to-sql-string test-flt)
-              (transform-bigint-1 test-int)
-              (clsql-sys:number-to-sql-string test-flt)
-              )))))
-
-(defun test-basic-forms ()
-  (append
-   (test-basic-forms-untyped)
-   '(
-     (deftest :BASIC/TYPE/1
+(setq *rt-basic*
+  '(
+    (deftest :BASIC/TYPE/1

        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)

-                   results)
-           (destructuring-bind (int float bigint str) row
+                  results)
+           (destructuring-bind (int float str) row

              (push (list (integerp int)
                          (typep float 'double-float)
              (push (list (integerp int)
                          (typep float 'double-float)

-                         (if (and (eq :odbc *test-database-type*)
-                                  (eq :postgresql *test-database-underlying-type*))
-                             ;; ODBC/Postgresql may return returns bigints as strings or integer
-                             ;; depending upon the platform
-                             t
-                           (integerp bigint))

                          (stringp str))
                    results))))
                          (stringp str))
                    results))))

-      ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
+      ((t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t)))

 
      (deftest :BASIC/TYPE/2
         (let ((results '()))
           (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
                     results)
 
      (deftest :BASIC/TYPE/2
         (let ((results '()))
           (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
                     results)

-            (destructuring-bind (int float bigint str) row
+            (destructuring-bind (int float str) row

               (setq results
                     (cons (list (double-float-equal 
                                  (transform-float-1 int)
               (setq results
                     (cons (list (double-float-equal 
                                  (transform-float-1 int)


@@ -70,34 +46,30 @@
                           results))))
           results)
        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
                           results))))
           results)
        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))

-     )))

 
 

-(defun test-basic-forms-untyped ()
-  '((deftest :BASIC/SELECT/1
+  (deftest :BASIC/SELECT/1

        (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
          (values 
           (length rows)
           (length (car rows))))
        (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
          (values 
           (length rows)
           (length (car rows))))

-      11 4)
+      11 3)

     
     (deftest :BASIC/SELECT/2
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)
     
     (deftest :BASIC/SELECT/2
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)

-           (destructuring-bind (int float bigint str) row
+           (destructuring-bind (int float str) row

              (push (list (stringp int)
                          (stringp float)
              (push (list (stringp int)
                          (stringp float)

-                         (stringp bigint)

                          (stringp str))
                    results))))
                          (stringp str))
                    results))))

-      ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
+      ((t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t)))

     
     (deftest :BASIC/SELECT/3
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)
     
     (deftest :BASIC/SELECT/3
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)

-           (destructuring-bind (int float bigint str) row
-             (declare (ignore bigint))
+           (destructuring-bind (int float str) row

              (push (list (double-float-equal 
                           (transform-float-1 (parse-integer int))
                           (parse-double float))
              (push (list (double-float-equal 
                           (transform-float-1 (parse-integer int))
                           (parse-double float))


@@ -124,7 +96,7 @@
               (transform-float-1 (parse-integer (first (aref rows i))))
               (parse-double (second (aref rows i)))))
             results)))
               (transform-float-1 (parse-integer (first (aref rows i))))
               (parse-double (second (aref rows i)))))
             results)))

-      ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
+      ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t)))

     
     (deftest :BASIC/MAP/2
        (let ((results '())
     
     (deftest :BASIC/MAP/2
        (let ((results '())


@@ -142,7 +114,7 @@
               (transform-float-1 (parse-integer (first (nth i rows))))
               (parse-double (second (nth i rows)))))
             results)))
               (transform-float-1 (parse-integer (first (nth i rows))))
               (parse-double (second (nth i rows)))))
             results)))

-      ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
+      ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t)))

     
     (deftest :BASIC/MAP/3
            (let ((results '())
     
     (deftest :BASIC/MAP/3
            (let ((results '())


@@ -159,12 +131,11 @@
                   (transform-float-1 (first (nth i rows)))
                   (second (nth i rows))))
                 results)))
                   (transform-float-1 (first (nth i rows)))
                   (second (nth i rows))))
                 results)))

-      ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
+      ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t)))

 
     (deftest :BASIC/DO/1
        (let ((results '()))
 
     (deftest :BASIC/DO/1
        (let ((results '()))

-         (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types nil)
-           (declare (ignore bigint))
+         (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil)

            (let ((int-number (parse-integer int)))
              (setq results
                    (cons (list (double-float-equal (transform-float-1
            (let ((int-number (parse-integer int)))
              (setq results
                    (cons (list (double-float-equal (transform-float-1


@@ -178,8 +149,7 @@
 
     (deftest :BASIC/DO/2
        (let ((results '()))
 
     (deftest :BASIC/DO/2
        (let ((results '()))

-         (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types :auto)
-           (declare (ignore bigint))
+         (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto)

            (setq results
                  (cons
                   (list (double-float-equal 
            (setq results
                  (cons
                   (list (double-float-equal 


@@ -191,9 +161,53 @@
                   results)))
          results)
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
                   results)))
          results)
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))

+
+
+    (deftest :BASIC/BIGINT/1
+       (let ((results '()))
+         (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto)
+                  results)
+           (destructuring-bind (int bigint) row
+             (push (list (integerp int)
+                         (if (and (eq :odbc *test-database-type*)
+                                  (eq :postgresql *test-database-underlying-type*))
+                             ;; ODBC/Postgresql may return returns bigints as strings or integer
+                             ;; depending upon the platform
+                             t
+                           (integerp bigint)))
+                   results))))
+      ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
+

     ))
 
 
     ))
 
 

+(defun test-basic-initialize ()
+  (ignore-errors
+   (clsql:execute-command "DROP TABLE TYPE_TABLE")
+   (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
+
+  (clsql:execute-command 
+   "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
+
+  (if (clsql-sys:db-type-has-bigint? *test-database-type*)
+    (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer, t_bigint BIGINT)")
+    (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer)"))
+
+  (dotimes (i 11)
+    (let* ((test-int (- i 5))
+          (test-flt (transform-float-1 test-int)))
+      (clsql:execute-command
+       (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
+              test-int
+              (clsql-sys:number-to-sql-string test-flt)
+              (clsql-sys:number-to-sql-string test-flt)
+              ))
+      (clsql:execute-command
+       (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
+              test-int
+              (transform-bigint-1 test-int)
+              )))))
+

 ;;;; Testing functions
 
 (defun transform-float-1 (i)
 ;;;; Testing functions
 
 (defun transform-float-1 (i)

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index 32e645bb277135ae9201299e2c7ff1f4aa86e0e7..a8cc0fdcfd1fd4d31649bbf6214f3b01742a610b 100644 (file)
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -28,7 +28,7 @@
            (sort (mapcar #'string-downcase
                          (clsql:list-tables :owner *test-database-user*))
                  #'string<))
            (sort (mapcar #'string-downcase
                          (clsql:list-tables :owner *test-database-user*))
                  #'string<))

-  "addr" "company" "ea_join" "employee" "type_table")
+  "addr" "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

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index b554625387ef557edc4a8376b5bfb877ba797f9f..35b08e2f6ddc7765c81f86e625c28f7bcc892bf4 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -19,6 +19,7 @@
 (defvar *report-stream* *standard-output* "Stream to send text report.")
 (defvar *sexp-report-stream* nil "Stream to send sexp report.")
 (defvar *rt-connection*)
 (defvar *report-stream* *standard-output* "Stream to send text report.")
 (defvar *sexp-report-stream* nil "Stream to send sexp report.")
 (defvar *rt-connection*)

+(defvar *rt-basic*)

 (defvar *rt-fddl*)
 (defvar *rt-fdml*)
 (defvar *rt-ooddl*)
 (defvar *rt-fddl*)
 (defvar *rt-fdml*)
 (defvar *rt-ooddl*)


@@ -219,7 +220,6 @@
 
 (defun test-initialise-database ()
   (test-basic-initialize)
 
 (defun test-initialise-database ()
   (test-basic-initialize)

-  

   (let ((*backend-warning-behavior*
         (if (member *test-database-type* '(:postgresql :postgresql-socket))
             :ignore
   (let ((*backend-warning-behavior*
         (if (member *test-database-type* '(:postgresql :postgresql-socket))
             :ignore


@@ -526,11 +526,9 @@
 
 
 (defun compute-tests-for-backend (db-type db-underlying-type)
 
 
 (defun compute-tests-for-backend (db-type db-underlying-type)

-  (declare (ignorable db-type))

   (let ((test-forms '())
        (skip-tests '()))
   (let ((test-forms '())
        (skip-tests '()))

-    (dolist (test-form (append (test-basic-forms)
-                              *rt-connection* *rt-fddl* *rt-fdml*
+    (dolist (test-form (append *rt-connection* *rt-basic* *rt-fddl* *rt-fdml*

                               *rt-ooddl* *rt-oodml* *rt-syntax*))
       (let ((test (second test-form)))
        (cond
                               *rt-ooddl* *rt-oodml* *rt-syntax*))
       (let ((test (second test-form)))
        (cond


@@ -556,9 +554,12 @@
                                :fdml/select/21 :fdml/select/32 
                                 :fdml/select/33))
           (push (cons test "not supported by sqlite") skip-tests))
                                :fdml/select/21 :fdml/select/32 
                                 :fdml/select/33))
           (push (cons test "not supported by sqlite") skip-tests))

+         ((and (not (clsql-sys:db-type-has-bigint? db-type))
+               (clsql-sys:in test :basic/bigint/1))
+          (push (cons test "bigint not supported") skip-tests))

          ((and (eql *test-database-underlying-type* :mysql)
                (clsql-sys:in test :fdml/select/26))
          ((and (eql *test-database-underlying-type* :mysql)
                (clsql-sys:in test :fdml/select/26))

-          (push (cons test "string table aliases not supported") skip-tests))
+          (push (cons test "string table aliases not supported on all mysql versions") skip-tests))

          ((and (eql *test-database-underlying-type* :mysql)
                (clsql-sys:in test :fdml/select/22 :fdml/query/5 
                                :fdml/query/7 :fdml/query/8))
          ((and (eql *test-database-underlying-type* :mysql)
                (clsql-sys:in test :fdml/select/22 :fdml/query/5 
                                :fdml/query/7 :fdml/query/8))


@@ -585,4 +586,4 @@
   (rapid-load :mysql))
 
 (defun rlo ()
   (rapid-load :mysql))
 
 (defun rlo ()

-  (rapid-load :odbc))
+  (rapid-load :oracle))