X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fclasses.lisp;h=bf74b6ecc3e4c8e6f01fee30820eaa91517421bf;hb=b2ff4969e20cce173d403de7542d5bf0e46938d7;hp=62033591985db4e4ab3e64a4b100e81c89e7fc4b;hpb=e34a3ace07250c5c55b3f6598459ef7b6d292bdb;p=clsql.git diff --git a/sql/classes.lisp b/sql/classes.lisp index 6203359..bf74b6e 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -119,10 +119,7 @@ :initform "NULL") (type :initarg :type - :initform "NULL") - (params - :initarg :params - :initform nil)) + :initform "NULL")) (:documentation "An SQL Attribute identifier.")) (defmethod collect-table-refs (sql) @@ -144,7 +141,7 @@ :type ',type))) (defmethod output-sql ((expr sql-ident-attribute) database) - (with-slots (qualifier name type params) + (with-slots (qualifier name type) expr (if (and (not qualifier) (not type)) (write-string (sql-escape (convert-to-db-default-case @@ -169,9 +166,9 @@ (defmethod output-sql-hash-key ((expr sql-ident-attribute) database) (declare (ignore database)) - (with-slots (qualifier name type params) + (with-slots (qualifier name type) expr - (list 'sql-ident-attribute qualifier name type params))) + (list 'sql-ident-attribute qualifier name type))) ;; For SQL Identifiers for tables (defclass sql-ident-table (sql-ident) @@ -770,8 +767,11 @@ uninclusive, and the args from that keyword to the end." (if (stringp db-type) db-type ; override definition (database-get-type-specifier (car type) (cdr type) database)) *sql-stream*) - (let ((constraints - (database-constraint-statement constraints database))) + (let ((constraints (database-constraint-statement + (if (and db-type (symbolp db-type)) + (cons db-type constraints) + constraints) + database))) (when constraints (write-string " " *sql-stream*) (write-string constraints *sql-stream*))))))) @@ -824,7 +824,11 @@ uninclusive, and the args from that keyword to the end." (defparameter *constraint-types* (list (cons (symbol-name-default-case "NOT-NULL") "NOT NULL") - (cons (symbol-name-default-case "PRIMARY-KEY") "PRIMARY KEY"))) + (cons (symbol-name-default-case "PRIMARY-KEY") "PRIMARY KEY") + (cons (symbol-name-default-case "NOT") "NOT") + (cons (symbol-name-default-case "NULL") "NULL") + (cons (symbol-name-default-case "PRIMARY") "PRIMARY") + (cons (symbol-name-default-case "KEY") "KEY"))) ;; ;; Convert type spec to sql syntax @@ -835,9 +839,9 @@ uninclusive, and the args from that keyword to the end." (let ((output (assoc (symbol-name constraint) *constraint-types* :test #'equal))) (if (null output) - (error 'clsql-sql-syntax-error - :reason (format nil "unsupported column constraint '~a'" - constraint)) + (error 'sql-user-error + :message (format nil "unsupported column constraint '~A'" + constraint)) (cdr output)))) (defmethod database-constraint-statement (constraint-list database) @@ -853,9 +857,9 @@ uninclusive, and the args from that keyword to the end." *constraint-types* :test #'equal))) (if (null output) - (error 'clsql-sql-syntax-error - :reason (format nil "unsupported column constraint '~a'" - constraint)) + (error 'sql-user-error + :message (format nil "unsupported column constraint '~A'" + constraint)) (setq string (concatenate 'string string (cdr output)))) (if (< 1 (length constraint)) (setq string (concatenate 'string string " "))))))))