From: Kevin Rosenberg <kevin@rosenberg.net>
Date: Fri, 4 Sep 2009 17:46:09 +0000 (-0600)
Subject: Rework do-query to use database for special case
X-Git-Tag: v4.1.1~11
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=a58462f512e08c0eecf6a668a00a07ed7e858f64

Rework do-query to use database for special case
        * sql/fdml.lisp: Rework do-query to use supplied database
        parameter when passed a sql-object-query
        (thanks to JTK <jetmonk@gmail.com>)
---

diff --git a/ChangeLog b/ChangeLog
index 1e9678c..8e85b69 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+04 Sep 2009  Kevin Rosenberg <kevin@rosenberg.net>
+	* sql/fdml.lisp: Rework do-query to use supplied database
+	parameter when passed a sql-object-query 
+	(thanks to JTK <jetmonk@gmail.com>)
+
 31 Aug 2009  Kevin Rosenberg <kevin@rosenberg.net>
 	* sql/db-interface.lisp: Fix spelling error (thanks to 
 	David Thompson)
diff --git a/sql/fdml.lisp b/sql/fdml.lisp
index dc725f4..fcd6a3d 100644
--- a/sql/fdml.lisp
+++ b/sql/fdml.lisp
@@ -1,8 +1,6 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; The CLSQL Functional Data Manipulation Language (FDML).
 ;;;;
 ;;;; This file is part of CLSQL.
@@ -212,28 +210,28 @@ types are automatically computed for each field."
         (columns (gensym "COLUMNS-"))
         (row (gensym "ROW-"))
         (db (gensym "DB-")))
-    `(let ((,qe ,query-expression))
+    `(let ((,qe ,query-expression)
+           (,db ,database))
       (typecase ,qe
         (sql-object-query
-         (dolist (,row (query ,qe))
+         (dolist (,row (query ,qe :database ,db))
            (destructuring-bind ,args
                ,row
              ,@body)))
         (t
          ;; Functional query
-         (let ((,db ,database))
-           (multiple-value-bind (,result-set ,columns)
-               (database-query-result-set ,qe ,db
-                                          :full-set nil
+         (multiple-value-bind (,result-set ,columns)
+             (database-query-result-set ,qe ,db
+                                        :full-set nil
                                           :result-types ,result-types)
-             (when ,result-set
-               (unwind-protect
-                    (do ((,row (make-list ,columns)))
-                        ((not (database-store-next-row ,result-set ,db ,row))
-                         nil)
-                      (destructuring-bind ,args ,row
-                        ,@body))
-                 (database-dump-result-set ,result-set ,db))))))))))
+           (when ,result-set
+             (unwind-protect
+                  (do ((,row (make-list ,columns)))
+                      ((not (database-store-next-row ,result-set ,db ,row))
+                       nil)
+                    (destructuring-bind ,args ,row
+                      ,@body))
+               (database-dump-result-set ,result-set ,db)))))))))
 
 (defun map-query (output-type-spec function query-expression
                   &key (database *default-database*)