From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Sun, 9 May 2004 22:33:12 +0000 (+0000)
Subject: r9291: 9 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
X-Git-Tag: v3.8.6~488
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=5953db07cc2276392d0a81052d2d8c71d3252b5a

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 a7e3054..41b5822 100644
--- 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, 
diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index a8b1563..f981c90 100644
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -62,11 +62,11 @@
 
 #+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+)
-  (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))
diff --git a/sql/objects.lisp b/sql/objects.lisp
index fcb2a66..e3a1853 100644
--- 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))
-  (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*)
diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index 93d3597..5c95fcd 100644
--- 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"))
 
-(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"))
 
-(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"))
 
-(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"))
 
-(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"
diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 65b1d8a..6034918 100644
--- 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
-				:fdml/select/20))
+				:fdml/select/21))
 	   (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