r9461: 24 May 2004 Kevin Rosenberg <kevin@rosenberg.net>

        * db-oracle/oracle-sql.lisp: Add declaration so that SBCL runs efficiently.
        * tests/test-init.lisp: capitalize odbc backend name in banner
        * CONTRIBUTORS: Add note about Marcus' excellent work

diff --git a/CONTRIBUTORS b/CONTRIBUTORS
index 1a4efdac1494d9eb538e1b713e0715d280275a3a..6f95d36b4e229071975bba04a1a3df829c32b5a7 100644 (file)
--- a/CONTRIBUTORS
+++ b/CONTRIBUTORS
@@ -1,10 +1,10 @@
 CLSQL Contributors
 ------------------
 Kevin Rosenberg (main author CLSQL)
 CLSQL Contributors
 ------------------
 Kevin Rosenberg (main author CLSQL)

+Marcus Pearce <m.t.pearce@city.ac.uk> (initial port of USQL to CLSQL, many excellent commits)

 Pierre Mai (original author MaiSQL from which CLSQL was based)
 Pierre Mai (original author MaiSQL from which CLSQL was based)

-Marcus Pearce <m.t.pearce@city.ac.uk> (initial port of USQL to CLSQL)

 Aurelio Bignoli (SQLite backend)
 Aurelio Bignoli (SQLite backend)

-Marc Battyani
+Marc Battyani (Large object support for postgresql, initial connection pool code)

 
 
 USQL Contributors
 
 
 USQL Contributors

diff --git a/ChangeLog b/ChangeLog
index 1965c5b7e15014badfc6c0d7900638d2d1f8c0cf..6099d1164e4a82d78fa393e034efc380d52e2c90 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+24 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
+        * db-oracle/oracle-sql.lisp: Add declaration so that SBCL runs efficiently.
+       * tests/test-init.lisp: capitalize odbc backend name in banner
+       * CONTRIBUTORS: Add note about Marcus' excellent work
+       

 24 May 2004: Marcus Pearce (m.t.pearce@city.ac.uk) 
        * db-postgresql-socket/postgresql-socket-sql.lisp: replace 
        CLSQL-SIMPLE-WARNING with SQL-WARNING. 
 24 May 2004: Marcus Pearce (m.t.pearce@city.ac.uk) 
        * db-postgresql-socket/postgresql-socket-sql.lisp: replace 
        CLSQL-SIMPLE-WARNING with SQL-WARNING. 


@@ -23,7 +28,7 @@
        * sql/ooddl.lisp: NEW FILE: ooddl from objects.lisp (deleted). 
        * sql/oodml.lisp: NEW FILE: oodml from objects.lisp (deleted). 
        
        * sql/ooddl.lisp: NEW FILE: ooddl from objects.lisp (deleted). 
        * sql/oodml.lisp: NEW FILE: oodml from objects.lisp (deleted). 
        

-23 May 2004 Kevin Rosenberg
+23 May 2004 Kevin Rosenberg <kevin@rosenberg.net>

        * Version 2.10.22 released
        * sql/kmr-mop.lisp, sql/objects.lisp: Since SBCL is the only implementation that
        has reversed class slots, change the default for ordered-class-slots so that slots
        * Version 2.10.22 released
        * sql/kmr-mop.lisp, sql/objects.lisp: Since SBCL is the only implementation that
        has reversed class slots, change the default for ordered-class-slots so that slots


@@ -35,7 +40,7 @@
        in many cases expects integers.
        * test/test-fdml.lisp: Accomodate that Oracle returns doubles for computed columns
        
        in many cases expects integers.
        * test/test-fdml.lisp: Accomodate that Oracle returns doubles for computed columns
        

-22 May 2004 Kevin Rosenberg
+22 May 2004 Kevin Rosenberg <kevin@rosenberg.net>

        * Version 2.10.21 released
        * sql/sequences.lisp: Move generic sequence functions here from db-sqlite,
        db-odbc, and db-aodbc.
        * Version 2.10.21 released
        * sql/sequences.lisp: Move generic sequence functions here from db-sqlite,
        db-odbc, and db-aodbc.

diff --git a/db-oracle/foreign-resources.lisp b/db-oracle/foreign-resources.lisp
index 8756f5843435842e445fc8456b4247404964bfa9..919a21156e4f8f478b5cf2455f5ea2d6476eceae 100644 (file)
--- a/db-oracle/foreign-resources.lisp
+++ b/db-oracle/foreign-resources.lisp
@@ -39,10 +39,10 @@
          (cons res (gethash type *foreign-resource-hash*)))))
 
 (defmacro acquire-foreign-resource (type &optional size)
          (cons res (gethash type *foreign-resource-hash*)))))
 
 (defmacro acquire-foreign-resource (type &optional size)

-  `(let ((res (%get-resource ',type ,size)))
+  `(let ((res (%get-resource ,type ,size)))

      (unless res
        (setf res (make-foreign-resource
      (unless res
        (setf res (make-foreign-resource

-                 :type ',type :sizeof ,size
+                 :type ,type :sizeof ,size

                  :buffer (uffi:allocate-foreign-object ,type ,size)))
        (%insert-foreign-resource ',type res))
      (claim-foreign-resource res)))
                  :buffer (uffi:allocate-foreign-object ,type ,size)))
        (%insert-foreign-resource ',type res))
      (claim-foreign-resource res)))

diff --git a/db-oracle/oracle-api.lisp b/db-oracle/oracle-api.lisp
index e63351fcde4f5e878d0596fec7ddbd6895fec770..4b2bc0be4a93970982c6c4f50dc932ccdcc6c7eb 100644 (file)
--- a/db-oracle/oracle-api.lisp
+++ b/db-oracle/oracle-api.lisp
@@ -220,7 +220,7 @@
   (valuep      :pointer-void)
   (value_sz      :long)
   (dty      :unsigned-short)         
   (valuep      :pointer-void)
   (value_sz      :long)
   (dty      :unsigned-short)         

-  (indp      :pointer-void)
+  (indp      (* :short))

   (rlenp      (* :unsigned-short))          
   (rcodep      (* :unsigned-short))          
   (mode     :unsigned-long))
   (rlenp      (* :unsigned-short))          
   (rcodep      (* :unsigned-short))          
   (mode     :unsigned-long))

diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp
index f71b7f772836820ea7cb0b30938de3792e3a22e3..dfc3a155ae59a333f8255a95b50e57ddaf2723ed 100644 (file)
--- a/db-oracle/oracle-sql.lisp
+++ b/db-oracle/oracle-sql.lisp
@@ -31,8 +31,11 @@ Setting this constant to a moderate value should make it less
 likely that we'll have to worry about the CMUCL limit."))
 
 
 likely that we'll have to worry about the CMUCL limit."))
 
 

+(uffi:def-type vp-type :pointer-void)
+(uffi:def-type vpp-type (* :pointer-void))
+

 (defmacro deref-vp (foreign-object)
 (defmacro deref-vp (foreign-object)

-  `(uffi:deref-pointer ,foreign-object :pointer-void))
+  `(the vp-type (uffi:deref-pointer (the vpp-type ,foreign-object) :pointer-void)))

 
 ;; constants - from OCI?
 
 
 ;; constants - from OCI?
 


@@ -298,30 +301,6 @@ the length of that format.")
                      table))))
     (mapcar #'car (database-query query database nil nil))))
 
                      table))))
     (mapcar #'car (database-query query database nil nil))))
 

-(defmethod list-all-table-columns (table (db oracle-database))
-  (declare (string table))
-  (let* ((sql-stmt (concatenate
-                   'simple-string
-                   "select "
-                   "'',"
-                   "all_tables.OWNER,"
-                   "'',"
-                   "user_tab_columns.COLUMN_NAME,"
-                   "user_tab_columns.DATA_TYPE from user_tab_columns,"
-                   "all_tables where all_tables.table_name = '" table "'"
-                   " and user_tab_columns.table_name = '" table "'"))
-        (preresult (database-query sql-stmt db :auto nil)))
-    ;; PRERESULT is like RESULT except that it has a name instead of
-    ;; type codes in the fifth column of each row. To fix this, we
-    ;; destructively modify PRERESULT.
-    (dolist (preresult-row preresult)
-      (setf (fifth preresult-row)
-           (if (find (fifth preresult-row)
-                     #("NUMBER" "DATE")
-                     :test #'string=)
-               2 ; numeric
-               1))) ; string
-    preresult))

 
 (defmethod database-list-attributes (table (database oracle-database) &key owner)
   (let ((query
 
 (defmethod database-list-attributes (table (database oracle-database) &key owner)
   (let ((query


@@ -603,20 +582,24 @@ the length of that format.")
 ;; debugging only
             
 
 ;; debugging only
             
 

+(uffi:def-type byte-pointer (* :byte))
+(uffi:def-type ulong-pointer (* :unsigned-long))
+(uffi:def-type void-pointer-pointer (* :void-pointer))
+

 (defun make-query-cursor-cds (database stmthp result-types field-names)
   (declare (optimize (safety 3) #+nil (speed 3))
           (type oracle-database database)
           (type pointer-pointer-void stmthp))
   (with-slots (errhp) database
     (uffi:with-foreign-objects ((dtype-foreign :unsigned-short)
 (defun make-query-cursor-cds (database stmthp result-types field-names)
   (declare (optimize (safety 3) #+nil (speed 3))
           (type oracle-database database)
           (type pointer-pointer-void stmthp))
   (with-slots (errhp) database
     (uffi:with-foreign-objects ((dtype-foreign :unsigned-short)

-                          (parmdp ':pointer-void)
-                          (precision :byte)
-                          (scale :byte)
-                          (colname '(* :unsigned-char))
-                          (colnamelen :unsigned-long)
-                          (colsize :unsigned-long)
-                          (colsizesize :unsigned-long)
-                          (defnp ':pointer-void))
+                               (parmdp :pointer-void)
+                               (precision :byte)
+                               (scale :byte)
+                               (colname '(* :unsigned-char))
+                               (colnamelen :unsigned-long)
+                               (colsize :unsigned-long)
+                               (colsizesize :unsigned-long)
+                               (defnp ':pointer-void))

       (let ((buffer nil)
            (sizeof nil))
        (do ((icolumn 0 (1+ icolumn))
       (let ((buffer nil)
            (sizeof nil))
        (do ((icolumn 0 (1+ icolumn))


@@ -637,6 +620,7 @@ the length of that format.")
                        +oci-attr-data-type+
                        (deref-vp errhp))
          (let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short)))
                        +oci-attr-data-type+
                        (deref-vp errhp))
          (let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short)))

+           (declare (fixnum dtype))

            (case dtype
              (#.SQLT-DATE
               (setf buffer (acquire-foreign-resource :unsigned-char
            (case dtype
              (#.SQLT-DATE
               (setf buffer (acquire-foreign-resource :unsigned-char


@@ -668,11 +652,11 @@ the length of that format.")
                  (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)

-                        dtype #.SQLT-FLT))))          )
+                        dtype #.SQLT-FLT)))))

              ;; Default to SQL-STR
              ;; Default to SQL-STR

-             (t                
-              (setf (uffi:deref-pointer colsize :unsigned-long) 0
-                    dtype #.SQLT-STR)
+             (t
+              (setf (uffi:deref-pointer colsize :unsigned-long) 0)
+              (setf dtype #.SQLT-STR)

               (oci-attr-get (deref-vp parmdp)
                             +oci-dtype-param+ 
                             colsize
               (oci-attr-get (deref-vp parmdp)
                             +oci-dtype-param+ 
                             colsize


@@ -842,7 +826,9 @@ the length of that format.")
        (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)

-       (let ((server-version (caar (database-query "SELECT BANNER FROM V$VERSION WHERE BANNER LIKE '%Oracle%'" db nil nil))))
+       (let ((server-version
+              (caar (database-query
+                     "SELECT BANNER FROM V$VERSION WHERE BANNER LIKE '%Oracle%'" db nil nil))))

          (setf (slot-value db 'server-version) server-version
                (slot-value db 'major-server-version) (major-client-version-from-string
                                                       server-version)))
          (setf (slot-value db 'server-version) server-version
                (slot-value db 'major-server-version) (major-client-version-from-string
                                                       server-version)))


@@ -1049,28 +1035,6 @@ the length of that format.")
                             0))
   t)
 
                             0))
   t)
 

-(defparameter *constraint-types*
-  '(("NOT-NULL" . "NOT NULL")))
-
-(defmethod database-output-sql ((str string) (database oracle-database))
-  (if (and (null (position #\' str))
-          (null (position #\\ str)))
-      (format nil "'~A'" str)
-    (let* ((l (length str))
-          (buf (make-string (+ l 3))))
-      (setf (aref buf 0) #\')
-      (do ((i 0 (incf i))
-          (j 1 (incf j)))
-         ((= i l) (setf (aref buf j) #\'))
-       (if (= j (- (length buf) 1))
-           (setf buf (adjust-array buf (+ (length buf) 1))))
-       (cond ((eql (aref str i) #\')
-              (setf (aref buf j) #\')
-              (incf j)))
-       (setf (aref buf j) (aref str i)))
-      buf)))
-
-

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

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 9af59da503b6845fbcaee73612eaf5d07998abd1..981046e51f0d59b48efdd13c98ef09c3abed54ad 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -482,7 +482,7 @@
          (machine-type)
          db-type
          (if (not (eq db-type *test-database-underlying-type*))
          (machine-type)
          db-type
          (if (not (eq db-type *test-database-underlying-type*))

-             (format nil " with underlying type ~A" 
+             (format nil " with underlying type ~:@(~A~)" 

                      *test-database-underlying-type*)
              "")
          ))
                      *test-database-underlying-type*)
              "")
          ))