r9291: 9 May 2004 Kevin Rosenberg (kevin@rosenberg.net)

        * sql/test-fdml.lisp: Renumber SELECT tests to avoid overwriting
        a previous test
        * sql/test-init.lisp: Check test-database-underlying-type for
        ODBC/MySQL tests
        * sql/objects.lisp: Fix (setf slot-value-using-class) for Lispworks

diff --git a/ChangeLog b/ChangeLog
index a7e305407cf7cf8a33459f98c09cf1d1914eec87..41b58224f97980902b5d5354d84d83b9259d39cf 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+9 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
+       * sql/test-fdml.lisp: Renumber SELECT tests to avoid overwriting
+       a previous test
+       * sql/test-init.lisp: Check test-database-underlying-type for
+       ODBC/MySQL tests
+       * sql/objects.lisp: Fix (setf slot-value-using-class) for Lispworks
+       

 8 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) 
        * sql/operations.lisp: complete remaining operations for the sql 
        syntax: SUBSTR, SOME, ORDER-BY, GROUP-BY, NULL, DISTINCT, EXCEPT, 
 8 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) 
        * sql/operations.lisp: complete remaining operations for the sql 
        syntax: SUBSTR, SOME, ORDER-BY, GROUP-BY, NULL, DISTINCT, EXCEPT, 

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index a8b1563e3f061d26ee83e0c92d4eccf217fec280..f981c900be363b18be8e67cd8db6895e800d465e 100644 (file)
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -62,11 +62,11 @@
 
 #+lispworks
 (dolist (slot-option +extra-slot-options+)
 
 #+lispworks
 (dolist (slot-option +extra-slot-options+)

-  (process-slot-option standard-db-class slot-option))
+  (eval `(process-slot-option standard-db-class ,slot-option)))

 
 #+lispworks
 (dolist (class-option +extra-class-options+)
 
 #+lispworks
 (dolist (class-option +extra-class-options+)

-  (process-class-option standard-db-class class-option))
+  (eval `(process-class-option standard-db-class ,class-option)))

 
 (defmethod validate-superclass ((class standard-db-class)
                                (superclass standard-class))
 
 (defmethod validate-superclass ((class standard-db-class)
                                (superclass standard-class))

diff --git a/sql/objects.lisp b/sql/objects.lisp
index fcb2a66731549b58b7488b0575a428af31012e53..e3a1853df3efb3c05d164a9308e60500919dfdd3 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -47,8 +47,9 @@
 (defmethod (setf slot-value-using-class) (new-value (class standard-db-class)
                                          instance slot-def)
   (declare (ignore new-value))
 (defmethod (setf slot-value-using-class) (new-value (class standard-db-class)
                                          instance slot-def)
   (declare (ignore new-value))

-  (let ((slot-name (%svuc-slot-name slot-def))
-        (slot-kind (view-class-slot-db-kind slot-def)))
+  (let* ((slot-name (%svuc-slot-name slot-def))
+        (slot-object (%svuc-slot-object slot-def class))
+        (slot-kind (view-class-slot-db-kind slot-object)))

     (call-next-method)
     (when (and *db-auto-sync* 
               (not *db-initializing*)
     (call-next-method)
     (when (and *db-auto-sync* 
               (not *db-initializing*)

diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index 93d3597d8cc959b65366e144f238ee4d6424ca1e..5c95fcd19c2aeb9a65b9ed4da5a37f9d139dae17 100644 (file)
--- a/tests/test-fdml.lisp
+++ b/tests/test-fdml.lisp
@@ -350,25 +350,25 @@
                            :field-names nil :result-types nil :flatp t)
  ("1" "2" "3" "4"))
 
                            :field-names nil :result-types nil :flatp t)
  ("1" "2" "3" "4"))
 

-(deftest :fdml/select/20 
+(deftest :fdml/select/21 

   (clsql:select [substr [first-name] 1 4] :from [employee] 
                 :flatp t :order-by [emplid] :field-names nil)
  ("Vlad" "Jose" "Leon" "Niki" "Leon" "Yuri" "Kons" "Mikh" "Bori" "Vlad"))
 
   (clsql:select [substr [first-name] 1 4] :from [employee] 
                 :flatp t :order-by [emplid] :field-names nil)
  ("Vlad" "Jose" "Leon" "Niki" "Leon" "Yuri" "Kons" "Mikh" "Bori" "Vlad"))
 

-(deftest :fdml/select/21 
+(deftest :fdml/select/22 

   (clsql:select [\|\| [first-name] " " [last-name]] :from [employee]
                 :flatp t :order-by [emplid] :field-names nil)
  ("Vladamir Lenin" "Josef Stalin" "Leon Trotsky" "Nikita Kruschev"
  "Leonid Brezhnev" "Yuri Andropov" "Konstantin Chernenko" "Mikhail Gorbachev"
  "Boris Yeltsin" "Vladamir Putin"))
 
   (clsql:select [\|\| [first-name] " " [last-name]] :from [employee]
                 :flatp t :order-by [emplid] :field-names nil)
  ("Vladamir Lenin" "Josef Stalin" "Leon Trotsky" "Nikita Kruschev"
  "Leonid Brezhnev" "Yuri Andropov" "Konstantin Chernenko" "Mikhail Gorbachev"
  "Boris Yeltsin" "Vladamir Putin"))
 

-(deftest :fdml/select/22
+(deftest :fdml/select/23

  (clsql:select [emplid] :from [employee] :where [in [emplid] '(1 2 3 4)]
                         :flatp t :order-by [emplid] :field-names nil
                         :result-types nil)
  ("1" "2" "3" "4"))
 
  (clsql:select [emplid] :from [employee] :where [in [emplid] '(1 2 3 4)]
                         :flatp t :order-by [emplid] :field-names nil
                         :result-types nil)
  ("1" "2" "3" "4"))
 

-(deftest :fdml/select/23
+(deftest :fdml/select/24

  (clsql:select [distinct [first-name]] :from [employee] :flatp t
                :order-by [first-name] :field-names nil :result-types nil)
  ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladamir"
  (clsql:select [distinct [first-name]] :from [employee] :flatp t
                :order-by [first-name] :field-names nil :result-types nil)
  ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladamir"

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 65b1d8a2de0c3582cc7df42f85f5829b55e28d5d..6034918aa4502d691c94830ceefb22a3fd9d5ff4 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -540,10 +540,10 @@
           (push (cons test "fancy math not supported") skip-tests))
          ((and (eql *test-database-type* :sqlite)
                (clsql-base::in test :fddl/view/4 :fdml/select/10
           (push (cons test "fancy math not supported") skip-tests))
          ((and (eql *test-database-type* :sqlite)
                (clsql-base::in test :fddl/view/4 :fdml/select/10

-                               :fdml/select/20))
+                               :fdml/select/21))

           (push (cons test "not supported by sqlite") skip-tests))
           (push (cons test "not supported by sqlite") skip-tests))

-         ((and (eql *test-database-type* :mysql)
-               (clsql-base::in test :fdml/select/21 :fdml/query/5 
+         ((and (eql *test-database-underlying-type* :mysql)
+               (clsql-base::in test :fdml/select/22 :fdml/query/5 

                                :fdml/query/7 :fdml/query/8))
           (push (cons test "not supported by mysql") skip-tests))
          (t
                                :fdml/query/7 :fdml/query/8))
           (push (cons test "not supported by mysql") skip-tests))
          (t