prevent !foreign from escaping names in the constraint name twice
Tue Mar 16 01:38:22 PDT 2010
* prevent !foreign from escaping names in the constraint name twice
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
diff -rN -u old-postmodern/postmodern/deftable.lisp new-postmodern/postmodern/deftable.lisp
--- old-postmodern/postmodern/deftable.lisp 2014-07-30 06:14:00.000000000 -0700
+++ new-postmodern/postmodern/deftable.lisp 2014-07-30 06:14:00.000000000 -0700
@@ -72,11 +72,11 @@
*this* table, and, if the fields have different names in the table
referred to, another field or list of fields for the target table."
(labels ((fkey-name (target fields)
- (format nil "~a_~a_~{~a~^_~}_foreign" *table-name* target fields))
- (as-names (names)
- (mapcar #'to-sql-name (if (consp names) names (list names)))))
- (let* ((target (to-sql-name target))
- (fields (as-names fields))
- (target-fields (if target-fields (as-names target-fields) fields)))
+ (to-sql-name (format nil "~a_~a_~{~a~^_~}_foreign" *table-name* target fields))))
+ (unless (listp fields) (setf fields (list fields)))
+ (unless (listp target-fields) (setf target-fields (list target-fields)))
+ (let* ((target-name (to-sql-name target))
+ (field-names (mapcar #'to-sql-name fields))
+ (target-names (if target-fields (mapcar #'to-sql-name target-fields) field-names)))
(format nil "ALTER TABLE ~a ADD CONSTRAINT ~a FOREIGN KEY (~{~a~^, ~}) REFERENCES ~a (~{~a~^, ~})"
- *table-name* (fkey-name target fields) fields target target-fields))))
+ *table-name* (fkey-name target fields) field-names target-name target-names))))