# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1638420234 18000
# Node ID 72fe2afc82c75657913437c330cb1cb15b289678
# Parent  a1be2be82e9db4dfc913f49ec3cb24afa17abdcc
Fix (for :within-radius ... :origin ... :skip-origin t) and add tests

diff -r a1be2be82e9d -r 72fe2afc82c7 src/iterate.lisp
--- a/src/iterate.lisp	Wed Dec 01 20:52:30 2021 -0500
+++ b/src/iterate.lisp	Wed Dec 01 23:43:54 2021 -0500
@@ -518,6 +518,9 @@
     ; the point it is works in arbitrary dimensions.
 
   "
+  ;; TODO rewrite this as bare `for`s without all the generator cruft to avoid
+  ;; the bullshit SBCL `deleting unreachable code` garbage we get every time
+  ;; skip-origin is true.
   (let* ((delta-vars (ensure-list delta-vars))
          (origin-vars (mapcar (lambda (dv) (gensym (mkstr 'origin- dv)))
                               delta-vars))
@@ -539,7 +542,8 @@
              `((with ,skip = ,should-skip-origin)
                (when (and ,skip
                           ,@(iterate (for var :in (ensure-list delta-vars))
-                                     (collect `(zerop ,var))))
+                                     (for ovar :in origin-vars)
+                                     (collect `(= ,ovar ,var))))
                  (next ,control))))))))
 
 
diff -r a1be2be82e9d -r 72fe2afc82c7 test/iterate.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/iterate.lisp	Wed Dec 01 23:43:54 2021 -0500
@@ -0,0 +1,39 @@
+(in-package :losh.test)
+
+
+(define-test within-radius
+  (is (equal '(-1 0 1)  (iterate (for (x) :within-radius 1)                             (collect x))))
+  (is (equal '(-1 1)    (iterate (for (x) :within-radius 1 :skip-origin t)              (collect x))))
+  (is (equal '(9 10 11) (iterate (for (x) :within-radius 1                :origin (10)) (collect x))))
+  (is (equal '(9 11)    (iterate (for (x) :within-radius 1 :skip-origin t :origin (10)) (collect x))))
+
+  (is (equal '((-1 -1) (-1 0) (-1 1) (0 -1) (0 0) (0 1) (1 -1) (1 0) (1 1))
+             (iterate (for (x y) :within-radius 1) (collect (list x y)))))
+
+  (is (equal '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1))
+             (iterate (for (x y) :within-radius 1 :skip-origin t)
+                      (collect (list x y)))))
+
+  (is (equal '((9 99) (9 100) (9 101) (10 99) (10 101) (11 99) (11 100) (11 101))
+             (iterate (for (x y) :within-radius 1 :skip-origin t :origin (10 100))
+                      (collect (list x y)))))
+
+  (is (equal '((8 98) (8 99) (8 100) (8 101) (8 102)
+               (9 98) (9 99) (9 100) (9 101) (9 102)
+               (10 98) (10 99) (10 101) (10 102)
+               (11 98) (11 99) (11 100) (11 101) (11 102)
+               (12 98) (12 99) (12 100) (12 101) (12 102))
+             (iterate (for (x y) :within-radius 2 :skip-origin t :origin (10 100))
+                      (collect (list x y)))))
+
+  (is (equal '((9 99 999) (9 99 1000) (9 99 1001)
+               (9 100 999) (9 100 1000) (9 100 1001)
+               (9 101 999) (9 101 1000) (9 101 1001)
+               (10 99 999) (10 99 1000) (10 99 1001)
+               (10 100 999) (10 100 1001)
+               (10 101 999) (10 101 1000) (10 101 1001)
+               (11 99 999) (11 99 1000) (11 99 1001)
+               (11 100 999) (11 100 1000) (11 100 1001)
+               (11 101 999) (11 101 1000) (11 101 1001))
+             (iterate (for (x y z) :within-radius 1 :skip-origin t :origin (10 100 1000))
+                      (collect (list x y z))))))