r9231: add tests for fdml query, fix loop for single-variable, result-type :auto...

diff --git a/ChangeLog b/ChangeLog
index 5d23e7e20d63558ced0fd4504a3f1533b049f8f2..99b060d2c91b365881b6c1ee322b386e88c24e19 100644 (file)
--- 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 3c334b0b5433d665c5b531c05f87caa1313b6ce4..335a9d234b93a0b5ef37d16c872ab6c8f8840c10 100644 (file)
--- 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 c1133b4b5ba903f1ae8427ce76983affd9094275..c9a68a4e2e4105cc47b6f6ed917e681a765da6f8 100644 (file)
--- 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 906852be6d49d1d645f9e334167be60cc1b45863..a91cf9c62d6da49995799a309710cedaea27b08c 100644 (file)
--- 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 a3396e5ef3c95bcefdfd824dce8babfa7794c868..e30e396a130d38435195d1bf0806197cb21fc18e 100644 (file)
--- 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"))
+||#
 
 ))