Changeset 14355

Timestamp:

01/16/13 10:45:54 (11 years ago)

Author:

Mark Evenson

Message:

Fix loop and default value for of-type problem.

Patch and (most of) test by Stas.

Fixes #293.

Location:

trunk/abcl

Files:

• src/org/armedbear/lisp/loop.lisp (modified) (1 diff)
• test/lisp/abcl/bugs.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/loop.lisp

@@ -987 +987 @@
 (defun loop-typed-init (data-type &optional step-var-p)
   (when (and data-type (subtypep data-type 'number))
-    (if (or (subtypep data-type 'float)
-      (subtypep data-type '(complex float)))
-  (coerce (if step-var-p 1 0) data-type)
-  (if step-var-p 1 0))))
+    ;; From SBCL
+    (let ((init (if step-var-p 1 0)))
+      (flet ((like (&rest types)
+               (coerce init (find-if (lambda (type)
+                                       (subtypep data-type type))
+                                     types))))
+        (cond ((subtypep data-type 'float)
+               (like 'single-float 'double-float
+                     'short-float 'long-float 'float))
+              ((subtypep data-type '(complex float))
+               (like '(complex single-float)
+                     '(complex double-float)
+                     '(complex short-float)
+                     '(complex long-float)
+                     '(complex float)))
+              (t
+               init))))))
 
 (defun loop-optional-type (&optional variable)

trunk/abcl/test/lisp/abcl/bugs.lisp

@@ -126 +126 @@
   (probe-file (make-pathname :device (list "foo")))
 nil)
+
+;; http://trac.common-lisp.net/armedbear/ticket/293
+(deftest bugs.loop.1
+    (loop :with x :of-type (float 0) = 0.0
+       :for y :upto 1
+       :collecting (cons x y))
+  ((0.0 . 0) (0.0 . 1)))
+