From a58462f512e08c0eecf6a668a00a07ed7e858f64 Mon Sep 17 00:00:00 2001 From: Kevin Rosenberg Date: Fri, 4 Sep 2009 11:46:09 -0600 Subject: [PATCH] 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 ) --- ChangeLog | 5 +++++ sql/fdml.lisp | 30 ++++++++++++++---------------- 2 files changed, 19 insertions(+), 16 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1e9678c..8e85b69 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +04 Sep 2009 Kevin Rosenberg + * sql/fdml.lisp: Rework do-query to use supplied database + parameter when passed a sql-object-query + (thanks to JTK ) + 31 Aug 2009 Kevin Rosenberg * 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*) -- 2.34.1