r10190: 06 Dec 2004 Kevin Rosenberg <kevin@rosenberg.net>

        * Version 3.1.2
        * sql/ooddl.lisp: Accept patch from Klaus Harbo for
        update-object-joins.
        * sql/metaclass.lisp: Remove unnecssary (and runtime error
        causing) change-class invocation when running on CLISP.

diff --git a/ChangeLog b/ChangeLog
index 9f7a7f58b28a9977f810576d352a3d2d9bc30de5..a2e60eec21839a67fb7f96d97a6d38c6dcf143a8 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,15 @@
-03 Dec 2004 Kevin Rosenberg <kevin@rosenberg.net>
+06 Dec 2004 Kevin Rosenberg <kevin@rosenberg.net>
+       * Version 3.1.2
+       * sql/ooddl.lisp: Accept patch from Klaus Harbo for
+       update-object-joins.
+       * sql/metaclass.lisp: Remove unnecssary (and runtime error
+       causing) change-class invocation when running on CLISP.
        * db-mysql/mysql-api.lisp: Commit patch from Paul Werkowski
        to fix structure name.
        * sql/database.lisp: More specific error message with trying
        to use a database value of NIL.
+       * sql/expressions.lisp: Accept a string for the table name
+       in (sql-output sql-delete database) [suggested by Ed Symanzik].
        
 11 Nov 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * Version 3.1.1

diff --git a/debian/changelog b/debian/changelog
index 0a4ea088e0ed25dbc8bfeade6b5dca6c3d447b06..059f77df95bf8e1739f03da794e516d06328f550 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (3.1.2-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon,  6 Dec 2004 23:09:57 -0700
+
 cl-sql (3.1.1-1) unstable; urgency=low
 
   * New upstream

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 88293b30d360e24207e187e85c54e12bac7d99dd..96013deaae1a25883dbb497cd7a3e5138907ad57 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -694,7 +694,7 @@ uninclusive, and the args from that keyword to the end."
     stmt
     (write-string "DELETE FROM " *sql-stream*)
     (typecase from
-      (symbol (write-string (sql-escape from) *sql-stream*))
+      ((or symbol string) (write-string (sql-escape from) *sql-stream*))
       (t  (output-sql from database)))
     (when where
       (write-string " WHERE " *sql-stream*)

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index ae511ee71c9f6c953952f065bcb3b4dfc9cac5e3..c778f11d0ccb1821f94ecde3b322063b42e2c5ea 100644 (file)
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -511,9 +511,9 @@ which does type checking before storing a value in a slot."
        (t
         (let ((type-predicate #+openmcl (slot-value esd 'ccl::type-predicate)))
           #-openmcl (declare (ignore type-predicate))
-          (change-class esd 'view-class-effective-slot-definition
-                        #+allegro :name 
-                        #+allegro (slot-definition-name dsd))
+          #-clisp (change-class esd 'view-class-effective-slot-definition
+                                #+allegro :name 
+                                #+allegro (slot-definition-name dsd))
           #+openmcl (setf (slot-value esd 'ccl::type-predicate)
                           type-predicate))
         

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 9d8154f44b6a0c6ea72c8c013d825884351f92dd..7f606636631fb913e8d4624c8c371f7e6f155946 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -737,15 +737,22 @@ maximum of MAX-LEN instances updated in each query."
                                                                      keys))
                                      :result-types :auto
                                      :flatp t)))
+
              (dolist (object objects)
                (when (or force-p (not (slot-boundp object slotdef-name)))
-                 (let ((res (find (slot-value object home-key) results 
-                                  :key #'(lambda (res) (slot-value res foreign-key))
-                                  :test #'equal)))
+                 (let ((res (remove-if-not #'(lambda (obj)
+                                               (equal obj (slot-value
+                                                           object
+                                                           home-key)))
+                                           results
+                                           :key #'(lambda (res)
+                                                    (slot-value res
+                                                                foreign-key)))))
                    (when res
-                     (setf (slot-value object slotdef-name) res)))))))))))
+                     (setf (slot-value object slotdef-name)
+                           (if (gethash :set dbi) res (car res)))))))))))))
   (values))
-  
+
 (defun fault-join-slot-raw (class object slot-def)
   (let* ((dbi (view-class-slot-db-info slot-def))
         (jc (gethash :join-class dbi)))