1.0.3.42: two LOOP buglets

 * Avoid bogus package-lock violations from LOOP, don't declare types
   for special variables in COMMON-LISP. Reported by Eric Marsen on
   sbcl-devel.
 * Avoid attempts to coerce loop variable initialization values to
   range-limited types. Reported by Andras Simon on sbcl-devel.

diff --git a/NEWS b/NEWS
index 1fe8e06..2c64fc9 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -12,7 +12,14 @@ changes in sbcl-1.0.4 relative to sbcl-1.0.3:
   * optimization: code using alien values with undeclared types is much faster.
   * optimization: the compiler is now able to open code SEARCH in more cases.
   * optimization: more compact typechecks on x86-64 (thanks to Lutz Euler)
-  * bug fix: >= and <= gave wrong results when used with NaNs.
+  * bug fix: using standardized COMMON-LISP special variables as loop
+    variables no longer signals bogus package lock violations. (reported
+    by Eric Marsden)
+  * bug fix: declaring local loop variables to be of a range-limited type
+    such as (SINGLE-FLOAT 1.0 2.0) no longer causes a compile-time error.
+    (reported by Andras Simon)
+  * bug fix: >= and <= gave wrong results when used with NaNs. (Some NaN
+    bugs remain on x86-64.)
   * bug fix: the #= and ## reader macros now interact reasonably with
     funcallable instances.
   * bug fix: type-checks for function arguments were compiled using the

diff --git a/src/code/loop.lisp b/src/code/loop.lisp
index 9ffa2c0..6b9a43a 100644 (file)
--- a/src/code/loop.lisp
+++ b/src/code/loop.lisp
@@ -917,10 +917,22 @@ code to be loaded.
 
 (defun loop-typed-init (data-type &optional step-var-p)
   (when (and data-type (sb!xc:subtypep data-type 'number))
-    (if (or (sb!xc:subtypep data-type 'float)
-            (sb!xc:subtypep data-type '(complex float)))
-        (coerce (if step-var-p 1 0) data-type)
-        (if step-var-p 1 0))))
+    (let ((init (if step-var-p 1 0)))
+      (flet ((like (&rest types)
+               (coerce init (find-if (lambda (type)
+                                       (sb!xc:subtypep data-type type))
+                                     types))))
+        (cond ((sb!xc:subtypep data-type 'float)
+               (like 'single-float 'double-float
+                     'short-float 'long-float 'float))
+              ((sb!xc: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)
   ;; No variable specified implies that no destructuring is permissible.
@@ -1046,7 +1058,9 @@ code to be loaded.
 (defun loop-declare-var (name dtype &optional step-var-p)
   (cond ((or (null name) (null dtype) (eq dtype t)) nil)
         ((symbolp name)
-         (unless (sb!xc:subtypep t dtype)
+         (unless (or (sb!xc:subtypep t dtype)
+                     (and (eq (find-package :cl) (symbol-package name))
+                          (eq :special (sb!int:info :variable :kind name))))
            (let ((dtype (let ((init (loop-typed-init dtype step-var-p)))
                           (if (sb!xc:typep init dtype)
                               dtype
@@ -1720,7 +1734,8 @@ code to be loaded.
                                  `(and ,indexv-type real)))))
            (:by
             (multiple-value-setq (form stepby-constantp stepby)
-              (loop-constant-fold-if-possible form `(and ,indexv-type (real (0)))))
+              (loop-constant-fold-if-possible form
+                                              `(and ,indexv-type (real (0)))))
             (unless stepby-constantp
               (loop-make-var (setq stepby (gensym "LOOP-STEP-BY-"))
                  form
@@ -1731,7 +1746,8 @@ code to be loaded.
               maybe invalid prepositions were specified in iteration path descriptor?"
                  prep)))
          (when (and odir dir (not (eq dir odir)))
-           (loop-error "conflicting stepping directions in LOOP sequencing path"))
+           (loop-error
+             "conflicting stepping directions in LOOP sequencing path"))
          (setq odir dir))
        (when (and sequence-variable (not sequencep))
          (loop-error "missing OF or IN phrase in sequence path"))
@@ -1749,8 +1765,9 @@ code to be loaded.
                                   :key #'type-declaration-of
                                   :from-end t)))
                  (sb!int:aver (eq decl %decl))
-                 (setf (cadr decl)
-                       `(and real ,(cadr decl))))))
+                 (when decl
+                   (setf (cadr decl)
+                         `(and real ,(cadr decl)))))))
            ;; default start
            ;; DUPLICATE KLUDGE: loop-make-var generates a temporary
            ;; symbol for indexv if it is NIL. See also the comment in

diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp
index 45d190a..cae55c5 100644 (file)
--- a/tests/loop.pure.lisp
+++ b/tests/loop.pure.lisp
@@ -238,3 +238,7 @@
       (macroexpand '(LOOP WITH A = 0 FOR A DOWNFROM 10 TO 0 DO (PRINT A))))
   (declare (ignore _))
   (assert (typep condition 'program-error)))
+
+;;; Loop variable with a range excluding 0, reported by Andras Simon.
+;;; (Used to signal an error during macroexpansion.)
+(assert (not (loop with foo of-type (single-float 1.0 2.0) = 1.5 do (return))))

diff --git a/tests/package-locks.impure.lisp b/tests/package-locks.impure.lisp
index e0f50fb..18e8bba 100644 (file)
--- a/tests/package-locks.impure.lisp
+++ b/tests/package-locks.impure.lisp
@@ -484,4 +484,9 @@
             test:*special*))
          program-error))
 
+;;; Bogus package lock violations from LOOP
+
+(assert (equal (loop :for *print-base* :from 2 :to 3 :collect *print-base*)
+               '(2 3)))
+
 ;;; WOOT! Done.

diff --git a/version.lisp-expr b/version.lisp-expr
index e15b531..edceaa9 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.3.41"
+"1.0.3.42"