r9219: sql/relations.lisp: fix to add subclassing support, minor optimizations [Edi...

diff --git a/ChangeLog b/ChangeLog
index 1cdc8b72d4ad3b53753ba8be6e617b072b36f046..9146445449ba08d571677d9c361d3d1fc77b9d94 100644 (file)
--- 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 44971228659cfcf3c109cbaecdadad2d956fd2a1..ebbb29fb5ffefd43215937d2b293955e509dec96 100644 (file)
--- 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 8c3a0ce62403a27c8868dca630e199e09e73e034..eb218b6791441299881ae95bca36e7a06934a931 100644 (file)
--- 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 87ae7175e5c4fadae4539695a62aef216391ec79..2f36da21643a81458c34872dd227a8085f37d422 100644 (file)
--- 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)