r9538: Cleaned up symbolic SQL syntax.

diff --git a/ChangeLog b/ChangeLog
index cef2d8b793eca04b022e1d043e09b9a47cb5338a..8469059221d7cfcf2578541bf5cbcbcad2b8d722 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,29 @@
+31 May 2004 Marcus Pearce <m.t.pearce@city.ac.uk> 
+       * db-odbc/odbc-sql.lisp: DB-TYPE replaced with DATABASE-TYPE in 
+       DATABASE-CONNECT. 
+       * sql/operations.lisp: substr now generates SUBSTR for use on 
+       Oracle; added a new operator SUBSTRING for use elsewhere. minus 
+       now generates MINUS for use on Oracle. Nvl signals an error if 
+       not called with exactly 2 arguments. Add concat function for use 
+       instead of the || operator on MySQL and Oracle. 
+       * sql/syntax.lisp: changed internal symbol for the || operator to 
+       CONCAT-OP. 
+       * sql/expressions.lisp: removed redundant and unused functions 
+       GENERATE-SQL (cf. SQL-OUTPUT) and DATABASE-CONSTRAINT-DESCRIPTION
+       (cf. MAKE-CONSTRAINTS-DESCRIPTION). 
+       * sql/generics.lisp: removed generic function for 
+       DATABASE-CONSTRAINT-DESCRIPTION (see above). 
+       * tests/test-syntax.lisp: modified/added tests according to changes
+       in sql/operations.lisp. 
+       * tests/test-fdml.lisp: changed SUBSTR to SUBSTRING in test 
+       :fdml/select/21.  
+       * sql/package.lisp: added the operators SQL-SUBSTRING, SQL-CONCAT-OP 
+       and SQL-USERENV to the shared exports list. Removed 
+       ROLLBACK-TRANSACTION, COMMIT-TRANSACTION, DATABASE-START-TRANSACTION, 
+       DATABASE-ABORT-TRANSACTION, DATABASE-COMMIT-TRANSACTION, 
+       TRANSACTION-LEVEL, TRANSACTION,  RECORD-SQL-COMMAND and 
+       RECORD-SQL-RESULT from shared exports list. 
+       

 30 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * db-postgresql/postgresl-sql.lisp: Avoid computing
        result-types lisp when nil result-types. Return only
 30 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * db-postgresql/postgresl-sql.lisp: Avoid computing
        result-types lisp when nil result-types. Return only

diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp
index 9f88a9c6e751d7b8c8b1d8ad8b19306d64f73042..385d378ee8adb9c084837503540e86f5775a2299 100644 (file)
--- a/db-odbc/odbc-sql.lisp
+++ b/db-odbc/odbc-sql.lisp
@@ -50,7 +50,7 @@
          (store-type-of-connected-database db)
          ;; Ensure this database type is initialized so can check capabilities of
          ;; underlying database
          (store-type-of-connected-database db)
          ;; Ensure this database type is initialized so can check capabilities of
          ;; underlying database

-         (initialize-database-type :database-type db-type)
+         (initialize-database-type :database-type database-type)

          db)
       (error ()        ;; Init or Connect failed
        (error 'sql-connection-error
          db)
       (error ()        ;; Init or Connect failed
        (error 'sql-connection-error

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index cc2e53b20fcab7f189b85ebd14fdd9a937607a99..10b1130aa11dd81f38a0dc5199bfa3788c9a5f74 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -186,11 +186,6 @@
     sql
     `(make-instance 'sql-ident-table :name ',name :table-alias ',alias)))
 
     sql
     `(make-instance 'sql-ident-table :name ',name :table-alias ',alias)))
 

-(defun generate-sql (expr database)
-  (let ((*sql-stream* (make-string-output-stream)))
-    (output-sql expr database)
-    (get-output-stream-string *sql-stream*)))
-

 (defmethod output-sql ((expr sql-ident-table) database)
   (with-slots (name alias)
     expr
 (defmethod output-sql ((expr sql-ident-table) database)
   (with-slots (name alias)
     expr


@@ -841,16 +836,6 @@ uninclusive, and the args from that keyword to the end."
 ;; Convert type spec to sql syntax
 ;;
 
 ;; Convert type spec to sql syntax
 ;;
 

-(defmethod database-constraint-description (constraint database)
-  (declare (ignore database))
-  (let ((output (assoc (symbol-name constraint) *constraint-types*
-                       :test #'equal)))
-    (if (null output)
-        (error 'sql-user-error
-               :message (format nil "unsupported column constraint '~A'"
-                               constraint))
-        (cdr output))))
-

 (defmethod database-constraint-statement (constraint-list database)
   (declare (ignore database))
   (make-constraints-description constraint-list))
 (defmethod database-constraint-statement (constraint-list database)
   (declare (ignore database))
   (make-constraints-description constraint-list))

diff --git a/sql/generics.lisp b/sql/generics.lisp
index d513bd34c1f27ab526d818279a185b5dc892e582..9ff64921b2413c39709815539e2328708aaad5b5 100644 (file)
--- a/sql/generics.lisp
+++ b/sql/generics.lisp
@@ -135,8 +135,6 @@ DATABASE-NULL-VALUE on the type of the slot."))
   )
 (defgeneric database-output-sql (arg database)
   )
   )
 (defgeneric database-output-sql (arg database)
   )

-(defgeneric database-constraint-description  (constraint database)
-  )

 (defgeneric database-pkey-constraint  (class database)
   )
 (defgeneric database-constraint-statement  (constraints database)
 (defgeneric database-pkey-constraint  (class database)
   )
 (defgeneric database-constraint-statement  (constraints database)

diff --git a/sql/operations.lisp b/sql/operations.lisp
index ad785b35ffc28b36e41bf41a070b88333e0abe81..9d8440a474ca8e41ec8fd12d83310a11085736e0 100644 (file)
--- a/sql/operations.lisp
+++ b/sql/operations.lisp
@@ -66,7 +66,7 @@
 
 (defsql sql-minus (:symbol "minus") (&rest rest)
   (make-instance 'sql-set-exp 
 
 (defsql sql-minus (:symbol "minus") (&rest rest)
   (make-instance 'sql-set-exp 

-                :operator 'except :sub-expressions rest))
+                :operator 'minus :sub-expressions rest))

 
 (defsql sql-limit (:symbol "limit") (&rest rest)
   (make-instance 'sql-query-modifier-exp 
 
 (defsql sql-limit (:symbol "limit") (&rest rest)
   (make-instance 'sql-query-modifier-exp 


@@ -139,16 +139,26 @@
   (make-instance 'sql-relational-exp
                  :operator 'in :sub-expressions rest))
 
   (make-instance 'sql-relational-exp
                  :operator 'in :sub-expressions rest))
 

-(defsql sql-concat (:symbol "concat") (&rest rest)
+(defsql sql-concat-op (:symbol "concat-op") (&rest rest)

   (make-instance 'sql-relational-exp
                 :operator '\|\| :sub-expressions rest))
 
   (make-instance 'sql-relational-exp
                 :operator '\|\| :sub-expressions rest))
 

+(defsql sql-concat (:symbol "concat") (&rest rest)
+  (make-instance 'sql-function-exp
+                :name 'concat :args rest))
+

 (defsql sql-substr (:symbol "substr") (&rest rest)
   (if (= (length rest) 3)
       (make-instance 'sql-function-exp 
 (defsql sql-substr (:symbol "substr") (&rest rest)
   (if (= (length rest) 3)
       (make-instance 'sql-function-exp 

-                    :name 'substring :args rest)
+                    :name 'substr :args rest)

       (error 'sql-user-error :message "SUBSTR must have 3 arguments.")))
 
       (error 'sql-user-error :message "SUBSTR must have 3 arguments.")))
 

+(defsql sql-substring (:symbol "substring") (&rest rest)
+  (if (= (length rest) 3)
+      (make-instance 'sql-function-exp 
+                    :name 'substring :args rest)
+      (error 'sql-user-error :message "SUBSTRING must have 3 arguments.")))
+

 (defsql sql-is (:symbol "is") (&rest rest)
   (make-instance 'sql-relational-exp
                 :operator 'is :sub-expressions rest))
 (defsql sql-is (:symbol "is") (&rest rest)
   (make-instance 'sql-relational-exp
                 :operator 'is :sub-expressions rest))


@@ -224,8 +234,10 @@
                 :name 'coalesce :args rest))
 
 (defsql sql-nvl (:symbol "nvl") (&rest rest)
                 :name 'coalesce :args rest))
 
 (defsql sql-nvl (:symbol "nvl") (&rest rest)

-  (make-instance 'sql-function-exp
-                :name 'coalesce :args rest))
+  (if (= (length rest) 2)      
+      (make-instance 'sql-function-exp
+                     :name 'coalesce :args rest)
+      (error 'sql-user-error :message "NVL accepts exactly 2 arguments.")))

 
 (defsql sql-userenv (:symbol "userenv") (&rest rest)
   (make-instance 'sql-function-exp
 
 (defsql sql-userenv (:symbol "userenv") (&rest rest)
   (make-instance 'sql-function-exp

diff --git a/sql/package.lisp b/sql/package.lisp
index 5f8cc4e4b66e9139087fd37bb4ae5b34293621e0..7db94ddcdc9aeee047be2f6f1bb83cf3730139bb 100644 (file)
--- a/sql/package.lisp
+++ b/sql/package.lisp
@@ -261,9 +261,6 @@
          #:sql-stream                  
          #:start-sql-recording         
          #:stop-sql-recording          
          #:sql-stream                  
          #:start-sql-recording         
          #:stop-sql-recording          

-         ;; CLSQL Extensions 
-         #:record-sql-command
-         #:record-sql-result

 
         ;; FDDL (fddl.lisp) 
         #:create-table                   
 
         ;; FDDL (fddl.lisp) 
         #:create-table                   


@@ -318,20 +315,13 @@
          #:commit                        
          #:rollback                     
          ;; CLSQL Extensions 
          #:commit                        
          #:rollback                     
          ;; CLSQL Extensions 

-         #:commit-transaction
-         #:rollback-transaction

          #:add-transaction-commit-hook
          #:add-transaction-rollback-hook
          #:start-transaction             
          #:in-transaction-p              
          #:add-transaction-commit-hook
          #:add-transaction-rollback-hook
          #:start-transaction             
          #:in-transaction-p              

-         #:database-start-transaction
-         #:database-abort-transaction
-         #:database-commit-transaction
-         #:transaction-level
-         #:transaction

         #:set-autocommit
 
         #:set-autocommit
 

-        ;;  OODDL (ooddl.lisp) 
+        ;; OODDL (ooddl.lisp) 

         #:standard-db-object               
         #:def-view-class                   
         #:create-view-from-class           
         #:standard-db-object               
         #:def-view-class                   
         #:create-view-from-class           


@@ -389,8 +379,8 @@
         #:sql-and
         #:sql-or
         #:sql-in
         #:sql-and
         #:sql-or
         #:sql-in

-        #:sql-concat

          #:sql-substr 
          #:sql-substr 

+         #:sql-concat-op 

         #:sql-=
         #:sql-<
          #:sql->
         #:sql-=
         #:sql-<
          #:sql->


@@ -407,7 +397,10 @@
          #:sql-distinct 
          #:sql-nvl 
          #:sql-slot-value
          #:sql-distinct 
          #:sql-nvl 
          #:sql-slot-value

+         #:sql-userenv 

          ;; CLSQL Extensions 
          ;; CLSQL Extensions 

+        #:sql-concat
+         #:sql-substring 

          #:sql-limit 
         #:sql-group-by
         #:sql-having
          #:sql-limit 
         #:sql-group-by
         #:sql-having

diff --git a/sql/syntax.lisp b/sql/syntax.lisp
index e4bf1507324dcbe1c4f73894110a76578803dd54..125bcaae6e154a3baa3df33ea10a5d31cce7b350 100644 (file)
--- a/sql/syntax.lisp
+++ b/sql/syntax.lisp
@@ -89,7 +89,7 @@ reader syntax is disabled."
   (declare (ignore char))
   (let ((sqllist (read-delimited-list #\] stream t)))
     (cond ((string= (write-to-string (car sqllist)) "||")
   (declare (ignore char))
   (let ((sqllist (read-delimited-list #\] stream t)))
     (cond ((string= (write-to-string (car sqllist)) "||")

-           (cons (sql-operator 'concat) (cdr sqllist)))
+           (cons (sql-operator 'concat-op) (cdr sqllist)))

           ((and (= (length sqllist) 1) (eql (car sqllist) '*))
            (apply #'generate-sql-reference sqllist))
           ((sql-operator (car sqllist))
           ((and (= (length sqllist) 1) (eql (car sqllist) '*))
            (apply #'generate-sql-reference sqllist))
           ((sql-operator (car sqllist))

diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index eac258f278200a4f5db41fc19428c5655a97dbc7..dce8d432411669a86df2b624db3894de2ce6fe50 100644 (file)
--- a/tests/test-fdml.lisp
+++ b/tests/test-fdml.lisp
@@ -368,7 +368,7 @@
  ("1" "2" "3" "4"))
 
 (deftest :fdml/select/21 
  ("1" "2" "3" "4"))
 
 (deftest :fdml/select/21 

-  (clsql:select [substr [first-name] 1 4] :from [employee] 
+  (clsql:select [substring [first-name] 1 4] :from [employee] 

                 :flatp t :order-by [emplid] :field-names nil)
  ("Vlad" "Jose" "Leon" "Niki" "Leon" "Yuri" "Kons" "Mikh" "Bori" "Vlad"))
 
                 :flatp t :order-by [emplid] :field-names nil)
  ("Vlad" "Jose" "Leon" "Niki" "Leon" "Yuri" "Kons" "Mikh" "Bori" "Vlad"))
 

diff --git a/tests/test-syntax.lisp b/tests/test-syntax.lisp
index 8591817cf58cf58d68c53d50942fc3b26f8ed34c..69265fefde6cc9dd1685c93976d8ad4c79946c7e 100644 (file)
--- a/tests/test-syntax.lisp
+++ b/tests/test-syntax.lisp
@@ -206,6 +206,10 @@
 
 (deftest :syntax/substr/1 
     (clsql:sql [substr [hello] 1 4])
 
 (deftest :syntax/substr/1 
     (clsql:sql [substr [hello] 1 4])

+ "SUBSTR(HELLO,1,4)")
+
+(deftest :syntax/substring/1 
+    (clsql:sql [substring [hello] 1 4])

  "SUBSTRING(HELLO,1,4)")
 
 
  "SUBSTRING(HELLO,1,4)")
 
 


@@ -213,6 +217,10 @@
     (clsql:sql [|| [foo] [bar] [baz]])
  "(FOO || BAR || BAZ)")
 
     (clsql:sql [|| [foo] [bar] [baz]])
  "(FOO || BAR || BAZ)")
 

+(deftest :syntax/concat/2
+    (clsql:sql [concat [foo] [bar]])
+ "CONCAT(FOO,BAR)")
+

 
 (deftest :syntax/pattern/1 
     (clsql:sql [like [foo] "%v"])
 
 (deftest :syntax/pattern/1 
     (clsql:sql [like [foo] "%v"])


@@ -249,6 +257,11 @@
     (clsql:sql [nvl [foo] "not specified"])
  "COALESCE(FOO,'not specified')")
 
     (clsql:sql [nvl [foo] "not specified"])
  "COALESCE(FOO,'not specified')")
 

+(deftest :syntax/nvl/1 
+    (clsql:sql [nvl [foo] "not specified"])
+ "COALESCE(FOO,'not specified')")
+
+

 
 (deftest :syntax/sets/1 
     (clsql:sql [union [select [foo] :from [bar]] [select [baz] :from [bar]]])
 
 (deftest :syntax/sets/1 
     (clsql:sql [union [select [foo] :from [bar]] [select [baz] :from [bar]]])


@@ -264,7 +277,7 @@
 
 (deftest :syntax/sets/4
     (clsql:sql [minus [select [foo] :from [bar]] [select [baz] :from [bar]]])
 
 (deftest :syntax/sets/4
     (clsql:sql [minus [select [foo] :from [bar]] [select [baz] :from [bar]]])

- "SELECT FOO FROM BAR EXCEPT SELECT BAZ FROM BAR")
+ "SELECT FOO FROM BAR MINUS SELECT BAZ FROM BAR")

 
 
 (deftest :syntax/function/1
 
 
 (deftest :syntax/function/1