sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'fix-605' into 'develop'

Browse source 
Fix 605

Closes #605

See merge request embeddable-common-lisp/ecl!226
This commit is contained in:
Marius Gerbershagen 2020-08-23 17:14:08 +00:00
commit 5277c82c85
2 changed files with 70 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/lsp/loop.lsp
View file

@ -659,8 +659,19 @@ collected result will be returned as the value of the LOOP."
(cond
((null tree) (car (push (gensym) *ignores*)))
((atom tree) tree)
(t (cons (subst-gensyms-for-nil (car tree))
(subst-gensyms-for-nil (cdr tree))))))
((atom (cdr tree))
(cons (subst-gensyms-for-nil (car tree))
(subst-gensyms-for-nil (cdr tree))))
(t
(do* ((acc (cons '&optional nil))
(acc-last acc)
(elt tree (cdr elt)))
((atom elt)
(setf (cdr acc-last) elt)
acc)
(setf (cdr acc-last)
(cons (subst-gensyms-for-nil (car elt)) nil))
(setf acc-last (cdr acc-last))))))
(defun loop-build-destructuring-bindings (crocks forms)
(if crocks

26
src/tests/normal-tests/ansi.lsp
View file

@ -45,6 +45,32 @@
(is-true (typep '* '(nest (3) 3)))
(is-true (typep 3 '(nest (2) 3)))))
;;; 6. Iteration
;;; Regression test for #605.
(test ansi.6.1.1.7-destructuring
(finishes
(loop with (a b) = '(1)
do (return (list a b))))
(finishes
(loop with (a b . rest) = '(1)
do (return (list a b rest))))
(is-equal '(1 nil 2 nil)
(loop with (a b) = '(1)
for (c d) = '(2)
do (return (list a b c d))))
(is-equal '(1 nil 2 nil nil)
(loop with (a b . rest) = '(1)
for (c d) = '(2)
do (return (list a b c d rest))))
(is-equal '(1 2 nil)
(loop for (a (b) ((c))) ='(1 (2))
do (return (list a b c))))
(signals error
(loop for (a (b)) ='(1 2)
do (return (list a b)))))
;;; 8. Structures
(ext:with-clean-symbols