projects
/
clsql.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
813ae0f
)
r9162: case-sensitive changes
author
Kevin M. Rosenberg
<kevin@rosenberg.net>
Sat, 24 Apr 2004 13:55:48 +0000
(13:55 +0000)
committer
Kevin M. Rosenberg
<kevin@rosenberg.net>
Sat, 24 Apr 2004 13:55:48 +0000
(13:55 +0000)
ChangeLog
patch
|
blob
|
history
debian/changelog
patch
|
blob
|
history
debian/control
patch
|
blob
|
history
sql/classes.lisp
patch
|
blob
|
history
sql/metaclasses.lisp
patch
|
blob
|
history
sql/objects.lisp
patch
|
blob
|
history
sql/operations.lisp
patch
|
blob
|
history
sql/sql.lisp
patch
|
blob
|
history
sql/syntax.lisp
patch
|
blob
|
history
tests/test-fdml.lisp
patch
|
blob
|
history
tests/test-syntax.lisp
patch
|
blob
|
history
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
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
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
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
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))
(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~]"
(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))
(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)
t))
(defmethod output-sql-hash-key ((expr sql-ident-attribute) database)
@@
-170,7
+173,7
@@
(declare (ignore environment))
(with-slots (alias name)
sql
(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)))
(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*
;; 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
;;
;; 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)
((typep arg 'sql-ident)
(slot-value arg 'name))
((stringp arg)
- (intern (s
tring-up
case arg)))))
+ (intern (s
ymbol-name-default-
case arg)))))
(defun column-name-from-arg (arg)
(cond ((symbolp 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)
((typep arg 'sql-ident)
(slot-value arg 'name))
((stringp arg)
- (intern (s
tring-up
case arg)))))
+ (intern (s
ymbol-name-default-
case arg)))))
(defun remove-keyword-arg (arglist akey)
(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
(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
(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))))
`(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))))
*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)
(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))
(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
&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))
#+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)
for the operator."
(typecase operation
(string nil)
- (symbol (gethash (s
tring-up
case (symbol-name operation))
+ (symbol (gethash (s
ymbol-name-default-
case (symbol-name operation))
*sql-op-table*))))
(defun sql-operation (operation &rest rest)
*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)))
: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
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")
(clsql:sql [foo bar])
"FOO.BAR")
-;; not sure about this one
(deftest :syntax/ident/3
(clsql:sql ["foo" bar])
(deftest :syntax/ident/3
(clsql:sql ["foo" bar])
- "
foo
.BAR")
+ "
FOO
.BAR")
;(deftest :syntax/ident/4
; (clsql:sql [foo "bar"])
;(deftest :syntax/ident/4
; (clsql:sql [foo "bar"])
@@
-66,10
+65,9
@@
(clsql:sql [foo bar :integer])
"FOO.BAR INTEGER")
(clsql:sql [foo bar :integer])
"FOO.BAR INTEGER")
-;; not sure about this one
(deftest :syntax/ident/7
(clsql:sql ["foo" bar :integer])
(deftest :syntax/ident/7
(clsql:sql ["foo" bar :integer])
- "
foo
.BAR INTEGER")
+ "
FOO
.BAR INTEGER")
(deftest :syntax/value/1
(deftest :syntax/value/1