r9427: 22 May 2004 Kevin Rosenberg

        * Oracle backend now fails 6 out of 200 tests
        * sql/sql.lisp: Ensure recyclebin is purged for oracle in
        TRUNCATE-DATABASE
        * db-oracle/oracle-sql.lisp: Add sequence functions, fix use of
        of owner phrases
        * db-oracle/oracle-objects.lisp: Fix type specifiers
        * tests/test-fddl.lisp: Allow :varchar2 and :number as data types
        * tests/test-init.lisp: Properly get username from Oracle connection-spec
        * TODO: Add that tests are needed for owner phrases

diff --git a/ChangeLog b/ChangeLog
index 7d40812a2ab57f6b992e83ce4c7ce13cdb8d2841..38ae4f6587708f7db1eea0f358a86c2b0d6850d5 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+22 May 2004 Kevin Rosenberg
+       * Oracle backend now fails 6 out of 200 tests
+       * sql/sql.lisp: Ensure recyclebin is purged for oracle in 
+       TRUNCATE-DATABASE
+       * db-oracle/oracle-sql.lisp: Add sequence functions, fix use of
+       of owner phrases
+       * db-oracle/oracle-objects.lisp: Fix type specifiers
+       * tests/test-fddl.lisp: Allow :varchar2 and :number as data types
+       * tests/test-init.lisp: Properly get username from Oracle connection-spec
+       * TODO: Add that tests are needed for owner phrases
+       
 22 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) 
        * sql/generics.lisp: reworked docstrings. Remove generics for 
        ADD-TO-RELATION and REMOVE-FROM-RELATION. 

diff --git a/TODO b/TODO
index 5eb551ea85caeed3df8cc8e12b1f332846d5123b..4c28e01853502ae762c0fe8cff84c60efcb3b625 100644 (file)
--- a/TODO
+++ b/TODO
@@ -8,6 +8,7 @@ TESTS TO ADD
 * test *db-auto-sync* 
 * for-each-row macro
 * universal-time 
+* owner phrases for postgresql and oracle backends
 
 COMMONSQL INCOMPATIBILITY
 

diff --git a/db-oracle/oracle-objects.lisp b/db-oracle/oracle-objects.lisp
index 581f7f9e2f6382b35d381c75383b37c5d7ba0d41..5e88bb1933bf7dc553642d0c9c1676a52906a1e1 100644 (file)
--- a/db-oracle/oracle-objects.lisp
+++ b/db-oracle/oracle-objects.lisp
@@ -51,29 +51,26 @@
   ((type (eql 'string)) args (database oracle-database))
   (if args
       (format nil "VARCHAR2(~A)" (car args))
-    (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")"))
-  "VARCHAR2(512)")
+    (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
 
 (defmethod database-get-type-specifier
   ((type (eql 'raw-string)) args (database oracle-database))
   (if args
       (format nil "VARCHAR2(~A)" (car args))
-    (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")"))
-  "VARCHAR2(256)")
+    (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
 
 (defmethod database-get-type-specifier
   ((type (eql 'float)) args (database oracle-database))
   (if args
-      (format nil "NUMBER(~A,~A)"
-             (or (first args) 38) (or (second args) 38))
-    "NUMBER"))
+      (format nil "NUMBER(~A,~A)" (or (first args) 38) (or (second args) 38))
+    "double precision"))
 
 (defmethod database-get-type-specifier
   ((type (eql 'long-float)) args (database oracle-database))
   (if args
       (format nil "NUMBER(~A,~A)"
              (or (first args) 38) (or (second args) 38))
-    "NUMBER"))
+    "double precision"))
 
 (defmethod database-get-type-specifier
     ((type (eql 'boolean)) args (database oracle-database))

diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp
index a041f87fa89329955538d67a23a5a2546011d353..6adf3b580ecdc59e1aabc07a1a678c9803289914 100644 (file)
--- a/db-oracle/oracle-sql.lisp
+++ b/db-oracle/oracle-sql.lisp
@@ -235,39 +235,47 @@ the length of that format.")
           (second  (1- (ub 6))))
       (encode-universal-time second minute hour day month year))))
 
-(defun owner-phrase (owner)
-  (if owner
-      (format nil " WHERE OWNER='~A'" owner)
-    ""))
 
 (defmethod database-list-tables ((database oracle-database) &key owner)
-  (mapcar #'car 
-         (database-query 
-          (concatenate 'string "select table_name from user_tables"
-                       (owner-phrase owner))
-          database nil nil))
-  #+nil
-  (values (database-query "select TABLE_NAME from all_catalog
-               where owner not in ('PUBLIC','SYSTEM','SYS','WMSYS','EXFSYS','CTXSYS','WKSYS','WK_TEST','MDSYS','DMSYS','OLAPSYS','ORDSYS','XDB')"
-                         db nil nil)))
-
-
-(defmethod database-list-views ((database oracle-database)
-                                 &key owner)
-  (mapcar #'car
-         (database-query
-          (concatenate 'string "select view_name from user_views"
-                       (owner-phrase owner))
-          database nil nil)))
-
+  (let ((query
+         (if owner
+             (format nil
+                     "select user_tables.table_name from user_tables,all_tables where user_tables.table_name=all_tables.table_name and all_tables.owner='~:@(~A~)'"
+                     owner)
+             "select table_name from user_tables")))
+    (mapcar #'car (database-query query database nil nil))))
+
+
+(defmethod database-list-views ((database oracle-database) &key owner)
+  (let ((query
+         (if owner
+             (format nil
+                     "select user_views.view_name from user_views,all_views where user_views.view_name=all_views.view_name and all_views.owner='~:@(~A~)'"
+                     owner)
+             "select view_name from user_views")))
+    (mapcar #'car
+         (database-query query database nil nil))))
 
 (defmethod database-list-indexes ((database oracle-database)
                                   &key (owner nil))
-  (mapcar #'car
-         (database-query 
-          (concatenate 'string "select index_name from user_indexes"
-                       (owner-phrase owner))
-          database nil nil)))
+  (let ((query
+         (if owner
+             (format nil
+                     "select user_indexes.index_name from user_indexes,all_indexes where user_indexes.index_name=all_indexes.index_name and all_indexes.owner='~:@(~A~)'"
+                     owner)
+             "select index_name from user_indexes")))
+    (mapcar #'car (database-query query database nil nil))))
+
+(defmethod database-list-table-indexes (table (database oracle-database)
+                                       &key (owner nil))
+  (let ((query
+         (if owner
+             (format nil
+                     "select user_indexes.index_name from user_indexes,all_indexes where user_indexes.table_name='~A' and user_indexes.index_name=all_indexes.index_name and all_indexes.owner='~:@(~A~)'"
+                     table owner)
+             (format nil "select index_name from user_indexes where table_name='~A'"
+                     table))))
+    (mapcar #'car (database-query query database nil nil))))
 
 (defmethod list-all-table-columns (table (db oracle-database))
   (declare (string table))
@@ -294,32 +302,30 @@ the length of that format.")
                1))) ; string
     preresult))
 
-
 (defmethod database-list-attributes (table (database oracle-database) &key owner)
-  (mapcar #'car
-         (database-query
-          (format nil
-                  "select column_name from user_tab_columns where table_name='~A'~A"
-                  table
-                  (if owner
-                      (format nil " AND OWNER='~A'" owner)
-                    ""))
-          database nil nil)))
+  (let ((query
+         (if owner
+             (format nil
+                     "select user_tab_columns.column_name from user_tab_columns,all_tables where user_tab_columns.table_name='~A' and all_tables.table_name=user_tab_columns.table_name and all_tables.owner='~:@(~A~)'"
+                     table owner)
+             (format nil
+                     "select column_name from user_tab_columns where table_name='~A'"
+                     table))))
+    (mapcar #'car (database-query query database nil nil))))
 
 (defmethod database-attribute-type (attribute (table string)
                                         (database oracle-database)
                                         &key (owner nil))
-  (let ((rows
-        (database-query
-         (format nil
-                 "select data_type,data_length,data_precision,data_scale,nullable from user_tab_columns where table_name='~A' and column_name='~A'~A"
-                 table attribute
-                 (if owner
-                     (format nil " AND OWNER='~A'" owner)
-                   ""))                  
-         database :auto nil)))
-    (destructuring-bind (type length precision scale nullable) (car rows)
-      (values (ensure-keyword type) length precision scale 
+  (let ((query          
+        (if owner
+            (format nil
+                    "select data_type,data_length,data_scale,nullable from user_tab_columns,all_tables where user_tab_columns.table_name='~A' and column_name='~A' and all_tables.table_name=user_tab_columns.table_name and all_tables.owner='~:@(~A~)'"
+                    table attribute owner)
+            (format nil
+                    "select data_type,data_length,data_scale,nullable from user_tab_columns where table_name='~A' and column_name='~A'"
+                    table attribute))))
+    (destructuring-bind (type length scale nullable) (car (database-query query database :auto nil))
+      (values (ensure-keyword type) length scale 
              (if (char-equal #\Y (schar nullable 0)) 1 0)))))
     
 ;; Return one row of the table referred to by QC, represented as a
@@ -872,17 +878,32 @@ the length of that format.")
 
 (defmethod database-sequence-next (sequence-name (database oracle-database))
   (caar
-   (query
+   (database-query
     (concatenate 'string "SELECT "
                 (sql-escape sequence-name)
                 ".NEXTVAL FROM dual"
-                ) :database database)))
+                )
+    database :auto nil)))
+
+(defmethod database-set-sequence-position (name position database)
+  (let* ((next (database-sequence-next name database))
+        (incr (- position next)))
+    (database-execute-command
+     (format nil "ALTER SEQUENCE ~A INCREMENT BY ~D" name incr)
+     database)
+    (database-sequence-next name database)
+    (database-execute-command
+     (format nil "ALTER SEQUENCE ~A INCREMENT BY 1" name)
+     database)))
 
 (defmethod database-list-sequences ((database oracle-database) &key owner)
-  (mapcar #'car (database-query 
-                (concatenate 'string "select sequence_name from user_sequences" 
-                             (owner-phrase owner))
-                database nil nil)))
+  (let ((query
+        (if owner
+            (format nil
+                    "select user_sequences.sequence_name from user_sequences,all_sequences where user_sequences.sequence_name=all_sequences.sequence_name and all_sequences.sequence_owner='~:@(~A~)'"
+                    owner)
+            "select sequence_name from user_sequences")))
+    (mapcar #'car (database-query query database nil nil))))
 
 (defmethod database-execute-command (sql-expression (database oracle-database))
   (database-query sql-expression database nil nil)

diff --git a/sql/sql.lisp b/sql/sql.lisp
index 057c135774ae2b4252c275bfa469ad2b8426b3a9..e3e064a7cdb983fef043fd58c3a8146ccc1a7601 100644 (file)
--- a/sql/sql.lisp
+++ b/sql/sql.lisp
@@ -58,7 +58,9 @@
   (dolist (index (list-indexes :database database))
     (drop-index index :database database))
   (dolist (seq (list-sequences :database database))
-    (drop-sequence seq :database database)))
+    (drop-sequence seq :database database))
+  (when (eq :oracle (database-type database))
+    (ignore-errors (execute-command "PURGE RECYCLEBIN" :database database))))
 
 (defun print-query (query-exp &key titles (formats t) (sizes t) (stream t)
                              (database *default-database*))

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index ab3da3bdf44ba5f835993391014ea05ad1a12a6d..7623b4bcc134ca2b803facb682eda24377c0e858 100644 (file)
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -85,15 +85,17 @@
   t)
 
 (deftest :fddl/attributes/4
-    (clsql:attribute-type [first-name] [employee]) 
-  :varchar 30 nil 1)
+    (multiple-value-bind (type length scale nullable)
+       (clsql:attribute-type [first-name] [employee])
+      (values (clsql-sys:in type :varchar :varchar2) length scale nullable))
+  t 30 nil 1)
 
 (deftest :fddl/attributes/5
-    (and (member (clsql:attribute-type [birthday] [employee]) '(:datetime :timestamp)) t)
+    (and (member (clsql:attribute-type [birthday] [employee]) '(:datetime :timestamp :date)) t)
   t)
 
 (deftest :fddl/attributes/6
-    (and (member (clsql:attribute-type [height] [employee]) '(:float :float8)) t)
+    (and (member (clsql:attribute-type [height] [employee]) '(:float :float8 :number)) t)
   t)
 
 

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 6738c1dfa48910b01a0687f4d3a2c97749fcb9de..d78e64ae978c4cdbf8359e83c2b43a46b32028b1 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -182,8 +182,10 @@
     (ignore-errors (create-database spec :database-type db-type)))
   
   (setf *test-database-type* db-type)
-  (when (>= (length spec) 3)
-    (setq *test-database-user* (third spec)))
+  (setf *test-database-user*
+    (cond
+     ((eq :oracle db-type) (second spec))
+     ((>= (length spec) 3) (third spec))))
   
   ;; Connect to the database
   (clsql:connect spec