From: Nikodemus Siivola Date: Sun, 18 Mar 2007 00:06:52 +0000 (+0000) Subject: 1.0.3.42: two LOOP buglets X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=dfa4d1c572e3a8d2836a462c107d95c5a1796e07;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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"