r9162: case-sensitive changes

diff --git a/ChangeLog b/ChangeLog
index 1c0bbf947f45b49b75cc3584b0cf1e58e117d5f4..b94e0db37ead5a2a2a8d1b12c7d2662057684117 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+24 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
+       * Version 2.9.4: Multiple changes to support Allegro's "modern"
+       lisp which uses a lowercase reader and has case-sensitive symbols
+       * sql/classes.lisp: Fix make-load-form bug for sql-ident-table
+       exposed by case-sensitive mlisp
+
 22 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
        * Version 2.9.3: All tests now pass on all platforms!
        * LATEST-TEST-RESULTS: New file with summary of test results

diff --git a/debian/changelog b/debian/changelog
index c9ebc87bdffb1d609d572fc2342c0fbb0c5a7798..caaf98f11c01da5bcffe9cd0410429610cd13ff0 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (2.9.4-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sat, 24 Apr 2004 07:54:45 -0600
+
 cl-sql (2.9.3-1) unstable; urgency=low
 
   * New upstream

diff --git a/debian/control b/debian/control
index b4e12fe05d949986bab9d3b8a7f75af451914982..9a2c41d977443cf77ab46592d5f6094be76f7d58 100644 (file)
--- a/debian/control
+++ b/debian/control
@@ -98,7 +98,7 @@ Description: Classic CLSQL high-level interface
 
 Package: cl-sql-tests
 Architecture: all
-Depends: cl-sql-base, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql, cl-rt, cl-ptester
+Depends: cl-sql-base, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql, cl-rt
 Suggests: acl-installer, libmyodbc, unixodbc,cl-sql-aodbc 
 Description: Testing suite for CLSQL
  This package contains a test suite for CLSQL. It requires manual

diff --git a/sql/classes.lisp b/sql/classes.lisp
index c6cf764ab9debdfea53a8c2494aa77883702f92d..df84cd4b8d5ff9dad158ecb7c1d03c7404839515 100644 (file)
--- a/sql/classes.lisp
+++ b/sql/classes.lisp
@@ -147,11 +147,14 @@
   (with-slots (qualifier name type params)
       expr
     (if (and (not qualifier) (not type))
-       (write-string (sql-escape (convert-to-db-default-case (symbol-name name) database)) *sql-stream*)
+       (write-string (sql-escape (convert-to-db-default-case 
+                                  (symbol-name name) database)) *sql-stream*)
       (format *sql-stream* "~@[~A.~]~A~@[ ~A~]"
-             (if qualifier (sql-escape qualifier) qualifier)
+             (when qualifier
+                 (convert-to-db-default-case (sql-escape qualifier) database))
              (sql-escape (convert-to-db-default-case name database))
-             type))
+             (when type
+                 (convert-to-db-default-case (symbol-name type) database))))
     t))
 
 (defmethod output-sql-hash-key ((expr sql-ident-attribute) database)
@@ -170,7 +173,7 @@
   (declare (ignore environment))
   (with-slots (alias name)
     sql
-    `(make-instance 'sql-ident-table :name name :alias ',alias)))
+    `(make-instance 'sql-ident-table :name ',name :table-alias ',alias)))
 
 (defun generate-sql (expr database)
   (let ((*sql-stream* (make-string-output-stream)))
@@ -690,8 +693,9 @@ uninclusive, and the args from that keyword to the end."
 ;; Column constraint types
 ;;
 (defparameter *constraint-types*
-  '(("NOT-NULL" . "NOT NULL")
-    ("PRIMARY-KEY" . "PRIMARY KEY")))
+  (list 
+   (cons (symbol-name-default-case "NOT-NULL") "NOT NULL") 
+   (cons (symbol-name-default-case "PRIMARY-KEY") "PRIMARY KEY")))
 
 ;;
 ;; Convert type spec to sql syntax

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index 0efa327dd94e123518c96255ea9ffea797a970e2..ac0592087e6add41f5d3ed03428b5f3056b638a2 100644 (file)
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -151,7 +151,7 @@ of the default method.  The extra allowed options are the value of the
        ((typep arg 'sql-ident)
         (slot-value arg 'name))
        ((stringp arg)
-        (intern (string-upcase arg)))))
+        (intern (symbol-name-default-case arg)))))
 
 (defun column-name-from-arg (arg)
   (cond ((symbolp arg)
@@ -159,7 +159,7 @@ of the default method.  The extra allowed options are the value of the
        ((typep arg 'sql-ident)
         (slot-value arg 'name))
        ((stringp arg)
-        (intern (string-upcase arg)))))
+        (intern (symbol-name-default-case arg)))))
 
 
 (defun remove-keyword-arg (arglist akey)

diff --git a/sql/objects.lisp b/sql/objects.lisp
index d17f30225b390d3cc4ce63d5e7ccc501eefc9486..a478e0d37eb4d49694d0f7bd7256a7838be7dad4 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -78,9 +78,11 @@
 (defmethod database-pkey-constraint ((class standard-db-class) database)
   (let ((keylist (mapcar #'view-class-slot-column (keyslots-for-class class))))
     (when keylist 
-      (format nil "CONSTRAINT ~APK PRIMARY KEY~A"
-              (database-output-sql (view-table class) database)
-              (database-output-sql keylist database)))))
+      (convert-to-db-default-case
+       (format nil "CONSTRAINT ~APK PRIMARY KEY~A"
+              (database-output-sql (view-table class) database)
+              (database-output-sql keylist database))
+       database))))
 
 
 (defun create-view-from-class (view-class-name

diff --git a/sql/operations.lisp b/sql/operations.lisp
index 08f7fdf7dd784ac4ab823d55220a8adb8bac3a5a..990ed34bd0b45a070feeafe771fa47d1f3f15d55 100644 (file)
--- a/sql/operations.lisp
+++ b/sql/operations.lisp
@@ -26,7 +26,7 @@
   `(progn
      (defun ,function ,@body)
      (let ((symbol (cadr (member :symbol ',definition-keys))))
-       (setf (gethash (if symbol (clsql-base-sys:symbol-name-default-case symbol) ',function)
+       (setf (gethash (if symbol (symbol-name-default-case symbol) ',function)
                      *sql-op-table*)
             ',function))))
 

diff --git a/sql/sql.lisp b/sql/sql.lisp
index a59989043b5e146daa35aec52be12b3658252a82..c322666eb2932fdf6c1dde4cde3d47e6e7fd7bd4 100644 (file)
--- a/sql/sql.lisp
+++ b/sql/sql.lisp
@@ -191,10 +191,11 @@ condition is true."
 
 (let ((keyword-package (symbol-package :foo)))
   (defmethod database-output-sql ((sym symbol) database)
-    (declare (ignore database))
-    (if (equal (symbol-package sym) keyword-package)
-        (concatenate 'string "'" (string sym) "'")
-        (symbol-name sym))))
+    (convert-to-db-default-case
+     (if (equal (symbol-package sym) keyword-package)
+        (concatenate 'string "'" (string sym) "'")
+        (symbol-name sym))
+     database)))
 
 (defmethod database-output-sql ((tee (eql t)) database)
   (declare (ignore database))
@@ -261,7 +262,8 @@ condition is true."
                           &key (database *default-database*))
   (database-describe-table
    database
-   (convert-to-db-default-case (symbol-name (slot-value table 'name)) database)))
+   (convert-to-db-default-case 
+    (symbol-name (slot-value table 'name)) database)))
 
 #+nil
 (defmethod add-storage-class ((self database) (class symbol) &key (sequence t))

diff --git a/sql/syntax.lisp b/sql/syntax.lisp
index bf3ce15484487696cd7e8fb1d6e4b5da5aa4fab1..371f046614ebe338a2d1325c4760968f184b2835 100644 (file)
--- a/sql/syntax.lisp
+++ b/sql/syntax.lisp
@@ -158,7 +158,7 @@ attribute and type."
 for the operator."
   (typecase operation
     (string nil)
-    (symbol (gethash (string-upcase (symbol-name operation))
+    (symbol (gethash (symbol-name-default-case (symbol-name operation))
                      *sql-op-table*))))
 
 (defun sql-operation (operation &rest rest)

diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index c8b58696c1c64bdc8819873e2a6ea55dccb5ddd7..929e30dd1979698df8f111677034d3507fa3e35a 100644 (file)
--- a/tests/test-fdml.lisp
+++ b/tests/test-fdml.lisp
@@ -361,7 +361,7 @@
                          :flatp t)
             results)
       (apply #'values (nreverse results)))
-  nil :COMMITTED nil ("lenin-nospam@soviet.org") :COMMITTED
+  nil :committed nil ("lenin-nospam@soviet.org") :committed
   nil ("lenin@soviet.org"))
 
 ;; runs a valid update and an invalid one within a transaction and checks

diff --git a/tests/test-syntax.lisp b/tests/test-syntax.lisp
index 62fe3f33803283f59303c8fa32c2cfb036311081..c2007f676f6130987337e33e87756519dd59ddd6 100644 (file)
--- a/tests/test-syntax.lisp
+++ b/tests/test-syntax.lisp
@@ -49,10 +49,9 @@
     (clsql:sql [foo bar])
   "FOO.BAR")
 
-;; not sure about this one 
 (deftest :syntax/ident/3
     (clsql:sql ["foo" bar])
-  "foo.BAR")
+  "FOO.BAR")
 
 ;(deftest :syntax/ident/4
 ;    (clsql:sql [foo "bar"])
@@ -66,10 +65,9 @@
     (clsql:sql [foo bar :integer])
   "FOO.BAR INTEGER")
 
-;; not sure about this one 
 (deftest :syntax/ident/7
     (clsql:sql ["foo" bar :integer])
-  "foo.BAR INTEGER")
+  "FOO.BAR INTEGER")
 
 
 (deftest :syntax/value/1