From d26a044593b10e62d1ba1c7b80266f55bc100d5d Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Tue, 4 May 2004 01:32:57 +0000
Subject: [PATCH] r9219: sql/relations.lisp: fix to add subclassing support,
 minor optimizations [Edi Weitz]

---
 ChangeLog             | 2 ++
 sql/relations.lisp    | 6 +++---
 tests/benchmarks.lisp | 4 ++--
 tests/test-init.lisp  | 3 ++-
 4 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 1cdc8b7..9146445 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -5,6 +5,8 @@
 	it can handle NIL values from the ODBC driver
 	* tests/benchmarks.lisp: New file with initial
 	benchmark suite
+	* sql/relations.lisp: fix to add subclassing support,
+	minor optimizations [Edi Weitz]
 	
 3 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
 	* Version 2.10.8	
diff --git a/sql/relations.lisp b/sql/relations.lisp
index 4497122..ebbb29f 100644
--- a/sql/relations.lisp
+++ b/sql/relations.lisp
@@ -18,7 +18,7 @@
 (defun synchronize-keys (src srckey dest destkey)
   (let ((skeys (if (listp srckey) srckey (list srckey)))
 	(dkeys (if (listp destkey) destkey (list destkey))))
-    (mapcar #'(lambda (sk dk)
+    (mapc #'(lambda (sk dk)
 		(setf (slot-value dest dk)
 		      (typecase sk
 			(symbol
@@ -28,7 +28,7 @@
 
 (defun desynchronize-keys (dest destkey)
   (let ((dkeys (if (listp destkey) destkey (list destkey))))
-    (mapcar #'(lambda (dk)
+    (mapc #'(lambda (dk)
 		(setf (slot-value dest dk) nil))
 	    dkeys)))
 
@@ -43,7 +43,7 @@
 	 (homekey (gethash :home-key dbinfo))
 	 (foreignkey (gethash :foreign-key dbinfo))
 	 (to-many (gethash :set dbinfo)))
-    (unless (equal (type-of value) join-class)
+    (unless (subtypep (type-of value) join-class)
       (error 'clsql-type-error :slotname slot-name :typespec join-class
              :value value))
     (when (gethash :target-slot dbinfo)
diff --git a/tests/benchmarks.lisp b/tests/benchmarks.lisp
index 8c3a0ce..eb218b6 100644
--- a/tests/benchmarks.lisp
+++ b/tests/benchmarks.lisp
@@ -27,7 +27,7 @@
    (c :initarg :c
       :type float)))
    
-(defun run-benchmarks (&key (report-stream *standard-output*) (sexp-report-stream nil) (count 1000))
+(defun run-benchmarks (&key (report-stream *standard-output*) (sexp-report-stream nil) (count 10000))
   (let ((specs (read-specs))
 	(*report-stream* report-stream)
 	(*sexp-report-stream* sexp-report-stream))
@@ -50,7 +50,7 @@
   (drop-view-from-class 'bench))
 
 (defun benchmark-init ()
-  (dotimes (i 100)
+  (dotimes (i 10)
     (execute-command "INSERT INTO BENCH (A,B,C) VALUES (123,'A Medium size string',3.14159)")))
 
 (defun benchmark-selects (n)
diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 87ae717..2f36da2 100644
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -379,7 +379,7 @@
       (clsql:initialize-database-type :database-type db-type))))
 
 (defun write-report-banner (report-type db-type stream)
-  (format *report-stream* 
+  (format stream
 	  "~&
 ******************************************************************************
 ***     CLSQL ~A begun at ~A
@@ -443,6 +443,7 @@
 
 
 (defun compute-tests-for-backend (db-type db-underlying-type)
+  (declare (ignorable db-type))
   (let ((test-forms '())
 	(skip-tests '()))
     (dolist (test-form (append (test-basic-forms)
-- 
2.34.1