From: Juho Snellman Date: Fri, 27 Mar 2009 00:39:39 +0000 (+0000) Subject: 1.0.26.22: Revert 1.0.26.12 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=601ac63712c45d18d3c29571d571fd57c8b681a2;p=sbcl.git 1.0.26.22: Revert 1.0.26.12 * And add testcase showing why the revert was needed. --- diff --git a/NEWS b/NEWS index 2242954..7059a78 100644 --- a/NEWS +++ b/NEWS @@ -8,8 +8,6 @@ changes in sbcl-1.0.27 relative to 1.0.26: --lose-on-corruption (which is still a good idea to use in production because stack exhaustion can happen in signal handlers which will likely lead to hangs.) - * bug fix: a type error is signaled for attempts to use the LOOP - keyword ACROSS for a NIL value. (thanks to Daniel Lowe) * bug fix: fix gc related interrupt handling bug on ppc (regression from 1.0.25.37, reported by Harald Hanche-Olsen) * bug fix: work around signal delivery bug in darwin (regression from diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 565ab9a..6b9a43a 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -916,11 +916,8 @@ code to be loaded. ;;;; loop types (defun loop-typed-init (data-type &optional step-var-p) - (cond - ((null data-type) - nil) - ((sb!xc:subtypep data-type 'number) - (let ((init (if step-var-p 1 0))) + (when (and data-type (sb!xc:subtypep data-type 'number)) + (let ((init (if step-var-p 1 0))) (flet ((like (&rest types) (coerce init (find-if (lambda (type) (sb!xc:subtypep data-type type)) @@ -935,11 +932,7 @@ code to be loaded. '(complex long-float) '(complex float))) (t - init))))) - ((sb!xc:subtypep data-type 'vector) - (coerce nil data-type)) - (t - nil))) + init)))))) (defun loop-optional-type (&optional variable) ;; No variable specified implies that no destructuring is permissible. diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp index cae55c5..44853c9 100644 --- a/tests/loop.pure.lisp +++ b/tests/loop.pure.lisp @@ -242,3 +242,8 @@ ;;; 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)))) + +;;; 1.0.26.12 used to signal a bogus type error for this. +(loop with x of-type (simple-vector 1) = (make-array '(1)) + repeat 1 + return x)