X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Floop.pure.lisp;h=6d5f3e4739207891390b594a0e1ffa49d92a6f4b;hb=16a6592367eec7c5e9da668ec42fd260e7705b0c;hp=95933d4d5ac8cd99b7294d4a0a3b6fc5cc0d7f34;hpb=caf8bb05a82659e688c125b418783bc8a3bd2be8;p=sbcl.git diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp index 95933d4..6d5f3e4 100644 --- a/tests/loop.pure.lisp +++ b/tests/loop.pure.lisp @@ -179,3 +179,60 @@ (assert (= (loop for v fixnum being each hash-value in ht sum v) 18)) (assert (raises-error? (loop for v float being each hash-value in ht sum v) type-error))) + +;; arithmetic indexes can be NIL or symbols. +(assert (equal (loop for nil from 0 to 2 collect nil) + '(nil nil nil))) +(assert (equal (loop for nil to 2 collect nil) + '(nil nil nil))) + +;; although allowed by the loop syntax definition in 6.2/LOOP, +;; 6.1.2.1.1 says: "The variable var is bound to the value of form1 in +;; the first iteration[...]"; since we can't bind (i j) to anything, +;; we give a program error. +(multiple-value-bind (function warnings-p failure-p) + (compile nil + `(lambda () + (loop for (i j) from 4 to 6 collect nil))) + (assert failure-p)) + +;; ...and another for indexes without FROM forms (these are treated +;; differently by the loop code right now +(multiple-value-bind (function warnings-p failure-p) + (compile nil + `(lambda () + (loop for (i j) to 6 collect nil))) + (assert failure-p)) + +(assert + (equal + (let ((x 2d0)) + (loop for d of-type double-float from 0d0 to 10d0 by x collect d)) + '(0d0 2d0 4d0 6d0 8d0 10d0))) +(assert + (equal + (let ((x 2d0)) + (loop for d of-type double-float downfrom 10d0 to 0d0 by x collect d)) + '(10d0 8d0 6d0 4d0 2d0 0d0))) + +(let ((fn (handler-case + (compile nil '(lambda () + (declare (special x y)) + (loop thereis (pop x) thereis (pop y)))) + (warning (c) (error "Warned: ~S" c))))) + (let ((x (list nil nil 1)) + (y (list nil 2 nil))) + (declare (special x y)) + (assert (= (funcall fn) 2)))) + +;;; Incorrect LIST type declaration, reported and patched by Teemu +;;; Kalvas: end testing is done "as if by atom" so this is supposed +;;; to work. +(assert (equal '(1 2) (loop for (a . b) on '(1 2 . 3) collect a))) + +;;; Detection of duplicate bindings, reported by Bruno Haible for CMUCL. +(multiple-value-bind (_ condition) + (ignore-errors + (macroexpand '(LOOP WITH A = 0 FOR A DOWNFROM 10 TO 0 DO (PRINT A)))) + (declare (ignore _)) + (assert (typep condition 'program-error)))