From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Tue, 4 May 2004 23:47:56 +0000 (+0000)
Subject: r9232: OODML LOOP now works on Lispworks
X-Git-Tag: v3.8.6~527
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=550cc94ed84c6cfc61830c25fac2b39e92393b06

r9232: OODML LOOP now works on Lispworks
---

diff --git a/ChangeLog b/ChangeLog
index 99b060d..22b9262 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,5 @@
 4 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
+	* Version 2.10.10-pre
 	* sql/metaclasses.lisp: Properly store specified-type from
 	direct-slot-definition and then store translated type in
 	effective-slot-definition
@@ -7,10 +8,10 @@
 	* base/basic-sql.lisp: Make :AUTO the default value for
 	: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. Remove 
+	* base/loop.lisp: Add object 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.
+	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
@@ -18,6 +19,8 @@
 	Add test that default :result-types is auto for FDML QUERY.
 	* sql/query.lisp: Set default for :result-types to :auto in
 	FDML QUERY.
+	* test/test-oodml.lisp: Enable OO loop iteration test with
+	slight change.
 	
 4 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) 
 	* Version 2.10.9
diff --git a/TODO b/TODO
index 2a8c417..4a25b42 100644
--- a/TODO
+++ b/TODO
@@ -35,9 +35,6 @@ COMMONSQL SPEC
       o get :target-slot working 
       o implement :retrieval :immediate 
 
-    LOOP
-      o should work with object queries as well as functional ones 
-
  >> Symbolic SQL syntax 
 
       o Complete sql expressions (see operations.lisp)
diff --git a/base/loop-extension.lisp b/base/loop-extension.lisp
index 335a9d2..526bafd 100644
--- a/base/loop-extension.lisp
+++ b/base/loop-extension.lisp
@@ -55,9 +55,8 @@
 
     (cond
       ;; Object query resulting in a list of returned object instances
-      #+ignore
       ((and (consp (first in-phrase))
-	    (consp (second (first in-phrase)))
+	    (string-equal "select" (symbol-name (caar in-phrase)))
 	    (eq 'quote (first (second (first in-phrase))))
 	    (symbolp (second (second (first in-phrase)))))
 
@@ -69,6 +68,7 @@
 	    (,step-var nil))
 	   ()
 	   ()
+	   ()
 	   (if (null ,result-var)
 	       t
 	       (progn
@@ -160,11 +160,38 @@
 
     (cond
       ;; Object query resulting in a list of returned object instances
-      ((and (consp (car in-phrase))
-	    (consp (second (car in-phrase)))
-	    (eq 'quote (first (second (car in-phrase))))
-	    (symbolp (second (second (car in-phrase)))))
-       (loop-error "object query not yet supported"))
+      ((and (string-equal "select" (symbol-name (car in-phrase)))
+	    (eq 'quote (first (second in-phrase)))
+	    (symbolp (second (second in-phrase))))
+
+       (let ((result-var (gensym "LOOP-RECORD-RESULT-"))
+	     (step-var (gensym "LOOP-RECORD-STEP-")))
+	 (values
+	  t
+	  nil
+	  `(,@(mapcar (lambda (v) `(,v nil)) iter-var)
+	    (,result-var ,in-phrase)
+	    (,step-var nil))
+	  ()
+	  ()
+	  ()
+	  `((if (null ,result-var)
+		t
+		(progn
+		  (setq ,step-var (first ,result-var))
+		  (setq ,result-var (rest ,result-var))
+		  nil)))
+	  `(,iter-var ,step-var)
+	  `((if (null ,result-var)
+		t
+		(progn
+		  (setq ,step-var (first ,result-var))
+		  (setq ,result-var (rest ,result-var))
+		  nil)))
+	   `(,iter-var ,step-var)
+	   ()
+	   ()
+	   )))
       
       ((consp iter-var)
        (let ((query-var (gensym "LOOP-RECORD-"))
diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index e30e396..7e875b2 100644
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -287,13 +287,11 @@
                                            "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))
+    (loop for (e) being the records in 
+          (select 'employee :where [married] :order-by [emplid])
+     collect (slot-value e 'last-name))
   ("Lenin" "Stalin" "Trotsky"))
-||#
 
 ))