From: Kevin M. Rosenberg Date: Tue, 4 May 2004 22:55:57 +0000 (+0000) Subject: r9231: add tests for fdml query, fix loop for single-variable, result-type :auto... X-Git-Tag: v3.8.6~528 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=49db0a8a6a6cde1581d5de0dd3c6822fd505472b r9231: add tests for fdml query, fix loop for single-variable, result-type :auto default for fdml query --- diff --git a/ChangeLog b/ChangeLog index 5d23e7e..99b060d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -8,12 +8,17 @@ :RESULT-TYPES for MAP-QUERY and DO-QUERY. * sql/objects.lisp: Add bigint type * base/loop.lisp: Add placeholder and error message for object - iteration. Use :result-type :auto for result-set. + iteration. Use :result-type :auto for result-set. Remove + duplicate (and non-correct) code for non-list variables by + simply making an atom variable into a list. * test/tests-basic.lisp: Add tests for :result-types for MAP-QUERY and DO-QUERY * test/test-fdml.lisp: Add test for result-types in LOOP and also using single symbol rather than a list for variables. - + Add test that default :result-types is auto for FDML QUERY. + * sql/query.lisp: Set default for :result-types to :auto in + FDML QUERY. + 4 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) * Version 2.10.9 * sql/objects.lisp: added derived type specifier for universal time. diff --git a/base/loop-extension.lisp b/base/loop-extension.lisp index 3c334b0..335a9d2 100644 --- a/base/loop-extension.lisp +++ b/base/loop-extension.lisp @@ -49,14 +49,42 @@ (ansi-loop::loop-error "Missing OF or IN iteration path.")) (unless from-phrase (setq from-phrase '(clsql-base:*default-database*))) + + (unless (consp variable) + (setq variable (list variable))) + (cond ;; Object query resulting in a list of returned object instances - ((and (consp in-phrase) - (consp (car in-phrase)) - (consp (second (car in-phrase))) - (eq 'quote (first (second (car in-phrase)))) - (symbolp (second (second (car in-phrase))))) - (ansi-loop::loop-error "object query not yet supported")) + #+ignore + ((and (consp (first in-phrase)) + (consp (second (first in-phrase))) + (eq 'quote (first (second (first in-phrase)))) + (symbolp (second (second (first in-phrase))))) + + (let ((result-var (ansi-loop::loop-gentemp + 'loop-record-result-)) + (step-var (ansi-loop::loop-gentemp 'loop-record-step-))) + `(((,variable nil ,@(and data-type (list data-type))) + (,result-var ,(first in-phrase)) + (,step-var nil)) + () + () + (if (null ,result-var) + t + (progn + (setq ,step-var (first ,result-var)) + (setq ,result-var (rest ,result-var)) + nil)) + (,variable ,step-var) + (null ,result-var) + () + (if (null ,result-var) + t + (progn + (setq ,step-var (first ,result-var)) + (setq ,result-var (rest ,result-var)) + nil)) + (,variable ,step-var)))) ((consp variable) (let ((query-var (ansi-loop::loop-gentemp 'loop-record-)) @@ -82,30 +110,7 @@ (not ,result-set-var) () (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var)) - (,variable ,step-var)))) - (t - (let ((query-var (ansi-loop::loop-gentemp 'loop-record-)) - (db-var (ansi-loop::loop-gentemp 'loop-record-database-)) - (result-set-var (ansi-loop::loop-gentemp - 'loop-record-result-set-))) - (push `(when ,result-set-var - (clsql-base:database-dump-result-set ,result-set-var ,db-var)) - ansi-loop::*loop-epilogue*) - `(((,variable nil ,@(and data-type (list data-type))) - (,query-var ,(first in-phrase)) - (,db-var ,(first from-phrase)) - (,result-set-var nil)) - ((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) - (setq ,result-set-var %rs ,variable (make-list %cols)))) - () - () - (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,variable)) - () - (not ,result-set-var) - () - (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,variable)) - ())))))) + (,variable ,step-var))))))) #+(or cmu scl sbcl openmcl allegro) (ansi-loop::add-loop-path '(record records tuple tuples) @@ -150,10 +155,12 @@ (unless from-phrase (setq from-phrase '(clsql-base:*default-database*))) + (unless (consp iter-var) + (setq iter-var (list iter-var))) + (cond ;; Object query resulting in a list of returned object instances - ((and (consp in-phrase) - (consp (car in-phrase)) + ((and (consp (car in-phrase)) (consp (second (car in-phrase))) (eq 'quote (first (second (car in-phrase)))) (symbolp (second (second (car in-phrase))))) @@ -188,32 +195,5 @@ t)) `(,iter-var ,step-var) () - ()))) - (t - (let ((query-var (gensym "LOOP-RECORD-")) - (db-var (gensym "LOOP-RECORD-DATABASE-")) - (result-set-var (gensym "LOOP-RECORD-RESULT-SET-"))) - (values - t - nil - `((,iter-var nil ,iter-var-data-type) (,query-var ,in-phrase) - (,db-var ,(first from-phrase)) - (,result-set-var nil)) - `((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) - (setq ,result-set-var %rs ,iter-var (make-list %cols)))) - () - () - `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,iter-var) - (when ,result-set-var - (clsql-base:database-dump-result-set ,result-set-var ,db-var)) - t)) - () - `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,iter-var) - (when ,result-set-var - (clsql-base:database-dump-result-set ,result-set-var ,db-var)) - t)) - () - () ())))))) diff --git a/sql/sql.lisp b/sql/sql.lisp index c1133b4..c9a68a4 100644 --- a/sql/sql.lisp +++ b/sql/sql.lisp @@ -29,7 +29,7 @@ (defmethod query ((expr %sql-expression) &key (database *default-database*) - (result-types nil) (flatp nil) (field-names t)) + (result-types :auto) (flatp nil) (field-names t)) (query (sql-output expr database) :database database :flatp flatp :result-types result-types :field-names field-names)) diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index 906852b..a91cf9c 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -298,6 +298,11 @@ ((1 10 "Park Place" "Leningrad" 123)) ("emplid" "street_number" "street_name" "city_field" "zip")) +(deftest :fdml/select/16 + (clsql:select [emplid] :from [employee] :where [= 1 [emplid]] + :field-names nil) + ((1))) + ;(deftest :fdml/select/11 ; (clsql:select [emplid] :from [employee] ; :where [= [emplid] [any [select [companyid] :from [company]]]] diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index a3396e5..e30e396 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -287,11 +287,13 @@ "Lenin"]]) (("Lenin" "Widgets Inc."))) -;(deftest :oodml/iteration/3 -; (loop for (e) being the tuples in -; [select 'employee :where [married] :order-by [emplid]] -; collect (slot-value e 'last-name)) -; ("Lenin" "Stalin" "Trotsky")) +#|| +(deftest :oodml/iteration/3 + (loop for (e) being the tuples in + [select 'employee :where [married] :order-by [emplid]] + collect (slot-value e 'last-name)) + ("Lenin" "Stalin" "Trotsky")) +||# ))