Fix interval-intersect for degenerate axes.

Closes #984.
ashinn · May 29, 2024 · e737e48 · e737e48
1 parent 609c78c
commit e737e48
Show file tree

Hide file tree

Showing 2 changed files with 5 additions and 2 deletions.
diff --git a/lib/srfi/231/base.scm b/lib/srfi/231/base.scm
@@ -218,7 +218,7 @@
                  (or (null? o) (apply = (map interval-dimension ls)))))
     (let ((lower (apply vector-map max (map interval-lb ls)))
           (upper (apply vector-map min (map interval-ub ls))))
-      (and (vector-every < lower upper)
+      (and (vector-every <= lower upper)
            (make-interval lower upper)))))
 
 (define (interval-translate iv translation)

diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld
@@ -2864,7 +2864,10 @@
               (c (make-interval '#(10 10) '#(20 20))))
           (test-error (interval-intersect 'a))
           (test-error (interval-intersect  a 'a))
-          (test-error (interval-intersect a b)))
+          (test-error (interval-intersect a b))
+          (test-assert (interval-intersect a))
+          (test-assert
+              (interval-intersect (make-interval '#(6 -9 -6) '#(6 -5 -3)))))
 
         (do ((i 0 (+ i 1)))
             ((= i tests))