Review identifier case :quote.

We added some confution about who's responsible to quote the SQL obejct
names in between src/utils/quoting.lisp and src/pgsql/pgsql-ddl.lisp and
as a result some migrations from MySQL with identifier case set to quote
where broken, as in #439.

To fix, remove any use of the format directive ~s in the PostgreSQL ddl
output methods: we consider that the quoting of ~s is to be decided in
apply-identifier-case. We then use ~a instead of ~s.

Fix #439.

src/pgsql/pgsql-ddl.lisp

@@ -8,12 +8,12 @@
 ;;; Schemas
 ;;;
 (defmethod format-create-sql ((schema schema) &key (stream nil) if-not-exists)
-  (format stream "CREATE SCHEMA~@[~IF NOT EXISTS~] ~s;"
+  (format stream "CREATE SCHEMA~@[~IF NOT EXISTS~] ~a;"
           if-not-exists
           (schema-name schema)))
 
 (defmethod format-drop-sql ((schema schema) &key (stream nil) cascade if-exists)
-  (format stream "DROP SCHEMA~@[ IF EXISTS~] ~s~@[ CASCADE~];"
+  (format stream "DROP SCHEMA~@[ IF EXISTS~] ~a~@[ CASCADE~];"
           if-exists (schema-name schema) cascade))
 
 
@@ -29,7 +29,7 @@
              (sqltype-extra sqltype)))))
 
 (defmethod format-drop-sql ((sqltype sqltype) &key (stream nil) cascade if-exists)
-  (format stream "DROP TYPE~:[~; IF EXISTS~] ~s~@[ CASCADE~];"
+  (format stream "DROP TYPE~:[~; IF EXISTS~] ~a~@[ CASCADE~];"
           if-exists (sqltype-name sqltype) cascade))
 
 
@@ -194,7 +194,7 @@
            ;; comes from one source only, the PostgreSQL database catalogs,
            ;; so don't question it, quote it.
            (format stream
-                   "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~s~@[ CASCADE~];"
+                   "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~a~@[ CASCADE~];"
                    (format-table-name (index-table index))
                    if-exists
                    (index-conname index)
@@ -211,12 +211,12 @@
 (defmethod format-create-sql ((fk fkey) &key (stream nil) if-not-exists)
   (declare (ignore if-not-exists))
   (if (and (fkey-name fk) (fkey-condef fk))
-      (format stream "ALTER TABLE ~a ADD CONSTRAINT ~s ~a"
+      (format stream "ALTER TABLE ~a ADD CONSTRAINT ~a ~a"
               (format-table-name (fkey-table fk))
               (fkey-name fk)
               (fkey-condef fk))
       (format stream
-              "ALTER TABLE ~a ADD ~@[CONSTRAINT ~s ~]FOREIGN KEY(~{~a~^,~}) REFERENCES ~a(~{~a~^,~})~:[~*~; ON UPDATE ~a~]~:[~*~; ON DELETE ~a~]"
+              "ALTER TABLE ~a ADD ~@[CONSTRAINT ~a ~]FOREIGN KEY(~{~a~^,~}) REFERENCES ~a(~{~a~^,~})~:[~*~; ON UPDATE ~a~]~:[~*~; ON DELETE ~a~]"
               (format-table-name (fkey-table fk))
               (fkey-name fk)            ; constraint name
               (fkey-columns fk)
@@ -230,7 +230,7 @@
 (defmethod format-drop-sql ((fk fkey) &key (stream nil) cascade if-exists)
   (let* ((constraint-name (fkey-name fk))
          (table-name      (format-table-name (fkey-table fk))))
-    (format stream "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~s~@[ CASCADE~];"
+    (format stream "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~a~@[ CASCADE~];"
             table-name if-exists constraint-name cascade)))
 
 

src/sources/mysql/mysql-cast-rules.lisp

@@ -6,7 +6,8 @@
 
 (defun enum-or-set-name (table-name column-name type ctype typemod)
   (declare (ignore type ctype typemod))
-  (string-downcase (format nil "~a_~a" table-name column-name)))
+  (apply-identifier-case
+   (format nil "~a_~a" (unquote table-name #\") (unquote column-name #\"))))
 
 ;;;
 ;;; The default MySQL Type Casting Rules
@@ -194,12 +195,12 @@
 
       ;; extra triggers
       ;;
-      ;; See the generic function `post-process-catalog' for the next step.
+      ;; See src/pgsql/pgsql-trigger.lisp
       ;;
       (when (string= extra "on update CURRENT_TIMESTAMP")
         (let* ((pro-name (format nil
                                  "on_update_current_timestamp_~a"
-                                 (column-name pgcol))))
+                                 (unquote (column-name pgcol) #\"))))
           (setf (column-extra pgcol)
                 (make-trigger :name :on-update-current-timestamp
                               :action "BEFORE UPDATE"

src/utils/quoting.lisp

@@ -43,6 +43,6 @@
 
     (ecase *identifier-case*
       (:downcase lowercase-identifier)
-      (:quote    (format nil "\"~a\""
+      (:quote    (format nil "~s"
                          (cl-ppcre:regex-replace-all "\"" identifier "\"\"")))
       (:none     identifier))))

src/utils/utils.lisp

@@ -25,14 +25,22 @@
 ;;;
 ;;; Unquote SQLite default values, might be useful elsewhere
 ;;;
-(defun unquote (string &optional (quote #\'))
+(defun unquote (string &optional (quote #\') (escape #\\))
   "Given '0', returns 0."
   (declare (type (or null simple-string) string))
   (when string
     (let ((l (length string)))
-      (if (char= quote (aref string 0) (aref string (1- l)))
-          (subseq string 1 (1- l))
-          string))))
+      (cond ((and (<= 2 l)               ; "string"
+                  (char= quote (aref string 0) (aref string (1- l))))
+             (subseq string 1 (1- l)))
+
+            ((and (<= 4 l)               ; \"string\"
+                  (char= escape (aref string 0) (aref string (- l 2)))
+                  (char= quote (aref string 1) (aref string (- l 1))))
+             (subseq string 2 (- l 2)))
+
+            (t
+             string)))))
 
 ;;;
 ;;; Process ~/ references at run-time (not at compile time!)