From 2f185bf0167aa5a0be8e82a0c1ee961ca28f1426 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 22 May 2004 15:17:02 +0000 Subject: [PATCH] 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 --- ChangeLog | 11 +++ TODO | 1 + db-oracle/oracle-objects.lisp | 13 ++-- db-oracle/oracle-sql.lisp | 131 ++++++++++++++++++++-------------- sql/sql.lisp | 4 +- tests/test-fddl.lisp | 10 +-- tests/test-init.lisp | 6 +- 7 files changed, 106 insertions(+), 70 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7d40812..38ae4f6 100644 --- 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 5eb551e..4c28e01 100644 --- 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 581f7f9..5e88bb1 100644 --- 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 a041f87..6adf3b5 100644 --- 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 057c135..e3e064a 100644 --- 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 ab3da3b..7623b4b 100644 --- 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 6738c1d..d78e64a 100644 --- 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 -- 2.34.1