r9403: Rework conditions to be CommonSQL backward compatible

[clsql.git] / sql / objects.lisp

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 869e643f23a386ffebd8bedd7db6fd09400d9ba8..1c309751883cefc56a3f168088d01b75c9d1c5c4 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -317,10 +317,10 @@ superclass of the newly-defined View Class."
          (basetype (if (listp slot-type) (car slot-type) slot-type)))
     (when (and slot-type val)
       (unless (typep val basetype)
-        (error 'clsql-type-error
-               :slotname (slot-definition-name slotdef)
-               :typespec slot-type
-               :value val)))))
+        (error 'sql-user-error
+              :message
+              (format nil "Invalid value ~A in slot ~A, not of type ~A."
+                      val (slot-definition-name slotdef) slot-type))))))
 
 ;;
 ;; Called by find-all
@@ -423,7 +423,7 @@ superclass of the newly-defined View Class."
        (let ((qualifier (key-qualifier-for-instance instance :database vd)))
          (delete-records :from vt :where qualifier :database vd)
          (setf (slot-value instance 'view-database) nil))
-       (error 'clsql-no-database-error :database nil))))
+       (signal-no-database-error vd))))
 
 (defmethod update-instance-from-records ((instance standard-db-object)
                                          &key (database *default-database*))
@@ -968,8 +968,8 @@ superclass of the newly-defined View Class."
 (defun find-all (view-classes 
                 &rest args
                 &key all set-operation distinct from where group-by having 
-                     order-by order-by-descending offset limit refresh
-                     flatp result-types inner-join on 
+                     order-by offset limit refresh flatp result-types 
+                      inner-join on 
                      (database *default-database*)
                      instances)
   "Called by SELECT to generate object query results when the
@@ -1020,12 +1020,6 @@ superclass of the newly-defined View Class."
          (setq fullsels 
                  (append fullsels (mapcar #'(lambda (att) (cons nil att))
                                           (listify ob))))))
-      (dolist (ob (listify order-by-descending))
-       (when (and ob (not (member ob (mapcar #'cdr fullsels)
-                                  :test #'ref-equal)))
-         (setq fullsels 
-               (append fullsels (mapcar #'(lambda (att) (cons nil att))
-                                        (listify ob))))))
       (dolist (ob (listify distinct))
        (when (and (typep ob 'sql-ident) 
                   (not (member ob (mapcar #'cdr fullsels)