r9240: rework to avoid some sbcl optimization notes

diff --git a/ChangeLog b/ChangeLog
index b0e070e3be795962f9dbbb96bbb95b7b54ed9780..380400d8d605e71c0833bb09f07cc2aea14d0981 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 4 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
-       * Version 2.10.10-pre
+       * base/basic-sql.lisp: Avoid multiple evaluation
+       of query-expression in DO-QUERY
+       
+4 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
+       * Version 2.10.10
        * base/loop.lisp: Add object iteration. Use :result-type
        :auto for result-set. Remove 
        duplicate (and non-correct) code for non-list variables by

diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp
index ba55fba6e008991044db75a168967a4c3b81efcb..b0f40a5acb24e253e4941bf9daeac9c18ac702f4 100644 (file)
--- a/tests/test-basic.lisp
+++ b/tests/test-basic.lisp
@@ -53,20 +53,21 @@
                          (stringp str))
                    results))))
       ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
-    
 
      (deftest :BASIC/TYPE/2
         (let ((results '()))
           (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
                     results)
             (destructuring-bind (int float bigint str) row
-              (push (list (double-float-equal 
-                           (transform-float-1 int)
-                           float)
-                          (double-float-equal
-                           (parse-double str)
-                           float))
-                    results))))
+              (setq results
+                    (cons (list (double-float-equal 
+                                 (transform-float-1 int)
+                                 float)
+                                (double-float-equal
+                                 (parse-double str)
+                                 float))
+                          results))))
+          results)
        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
      )))
 
@@ -95,6 +96,7 @@
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)
            (destructuring-bind (int float bigint str) row
+             (declare (ignore bigint))
              (push (list (double-float-equal 
                           (transform-float-1 (parse-integer int))
                           (parse-double float))
@@ -108,7 +110,7 @@
        (let ((results '())
              (rows (map-query 'vector #'list "select * from TYPE_TABLE" 
                               :result-types nil)))
-         (declare (array rows))
+         (declare (type (simple-array list (*)) rows))
          (dotimes (i (length rows) results)
            (push
             (list
@@ -161,26 +163,31 @@
     (deftest :BASIC/DO/1
        (let ((results '()))
          (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types nil)
-           (push (list (double-float-equal 
-                        (transform-float-1 (parse-integer int))
-                        (parse-double float))
-                       (double-float-equal
-                        (parse-double str)
-                        (parse-double float)))
-                 results))
+           (declare (ignore bigint))
+           (let ((int-number (parse-integer int)))
+             (setq results
+                   (cons (list (double-float-equal (transform-float-1
+                                                    int-number)
+                                                   (parse-double float))
+                             (double-float-equal (parse-double str)
+                                                 (parse-double float)))
+                       results))))
          results)
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
-    
+
     (deftest :BASIC/DO/2
        (let ((results '()))
          (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types :auto)
-           (push (list (double-float-equal 
-                        (transform-float-1 int)
-                        float)
-                       (double-float-equal
-                        (parse-double str)
-                        float))
-                 results))
+           (declare (ignore bigint))
+           (setq results
+                 (cons
+                  (list (double-float-equal 
+                         (transform-float-1 int)
+                         float)
+                        (double-float-equal
+                         (parse-double str)
+                         float))
+                  results)))
          results)
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
     ))