r10190: 06 Dec 2004 Kevin Rosenberg <kevin@rosenberg.net>
authorKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 7 Dec 2004 06:10:37 +0000 (06:10 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 7 Dec 2004 06:10:37 +0000 (06:10 +0000)
        * 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.

ChangeLog
debian/changelog
sql/expressions.lisp
sql/metaclasses.lisp
sql/oodml.lisp

index 9f7a7f5..a2e60ee 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
index 0a4ea08..059f77d 100644 (file)
@@ -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
index 88293b3..96013de 100644 (file)
@@ -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*)
index ae511ee..c778f11 100644 (file)
@@ -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))
         
index 9d8154f..7f60663 100644 (file)
@@ -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)))