From 9a70270bf9a1d60323ded33ce52bd0904544c70b Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 24 Apr 2004 13:55:48 +0000 Subject: [PATCH] r9162: case-sensitive changes --- ChangeLog | 6 ++++++ debian/changelog | 6 ++++++ debian/control | 2 +- sql/classes.lisp | 16 ++++++++++------ sql/metaclasses.lisp | 4 ++-- sql/objects.lisp | 8 +++++--- sql/operations.lisp | 2 +- sql/sql.lisp | 12 +++++++----- sql/syntax.lisp | 2 +- tests/test-fdml.lisp | 2 +- tests/test-syntax.lisp | 6 ++---- 11 files changed, 42 insertions(+), 24 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1c0bbf9..b94e0db 100644 --- 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 c9ebc87..caaf98f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (2.9.4-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg 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 b4e12fe..9a2c41d 100644 --- 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 c6cf764..df84cd4 100644 --- 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 0efa327..ac05920 100644 --- 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 d17f302..a478e0d 100644 --- 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 08f7fdf..990ed34 100644 --- 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 a599890..c322666 100644 --- 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 bf3ce15..371f046 100644 --- 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 c8b5869..929e30d 100644 --- 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 62fe3f3..c2007f6 100644 --- 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 -- 2.34.1