From: Juho S. <js...@us...> - 2009-03-22 19:44:23
|
Update of /cvsroot/sbcl/sbcl/src/code In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv23843/src/code Modified Files: loop.lisp Log Message: 1.0.26.12: Don't allow (LOOP FOR X ACROSS A ...) where A evaluates to NIL * Patch by Daniel Lowe Index: loop.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/loop.lisp,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -r1.43 -r1.44 --- loop.lisp 18 Mar 2007 00:06:52 -0000 1.43 +++ loop.lisp 22 Mar 2009 19:44:13 -0000 1.44 @@ -916,8 +916,11 @@ ;;;; loop types (defun loop-typed-init (data-type &optional step-var-p) - (when (and data-type (sb!xc:subtypep data-type 'number)) - (let ((init (if step-var-p 1 0))) + (cond + ((null data-type) + nil) + ((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)) @@ -932,7 +935,11 @@ '(complex long-float) '(complex float))) (t - init)))))) + init))))) + ((sb!xc:subtypep data-type 'vector) + (coerce nil data-type)) + (t + nil))) (defun loop-optional-type (&optional variable) ;; No variable specified implies that no destructuring is permissible. |