From e737e489556646b980e66ccc7434b2a847818675 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 29 May 2024 09:04:46 +0900 Subject: [PATCH] Fix interval-intersect for degenerate axes. Closes #984. --- lib/srfi/231/base.scm | 2 +- lib/srfi/231/test.sld | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/srfi/231/base.scm b/lib/srfi/231/base.scm index 27b3a755..cd14c857 100644 --- 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 index afff5f4c..377efe6c 100644 --- 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))