From b5de5eca92af7eeb5741d6bf0123c31a9327277e Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 29 May 2024 09:08:26 +0900 Subject: [PATCH] interval-cartesian-product should accept zero args Closes #983. --- lib/srfi/231/base.scm | 7 ++++--- lib/srfi/231/test.sld | 23 ++--------------------- 2 files changed, 6 insertions(+), 24 deletions(-) diff --git a/lib/srfi/231/base.scm b/lib/srfi/231/base.scm index cd14c857..5a5166b6 100644 --- a/lib/srfi/231/base.scm +++ b/lib/srfi/231/base.scm @@ -247,9 +247,10 @@ (interval-ub iv) scales))) -(define (interval-cartesian-product iv0 . o) - (make-interval (apply vector-append (map interval-lb (cons iv0 o))) - (apply vector-append (map interval-ub (cons iv0 o))))) +(define (interval-cartesian-product . o) + (assert (every interval? o)) + (make-interval (apply vector-append (map interval-lb o)) + (apply vector-append (map interval-ub o)))) ;; Storage Classes diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld index 377efe6c..61717be3 100644 --- a/lib/srfi/231/test.sld +++ b/lib/srfi/231/test.sld @@ -3346,27 +3346,7 @@ (make-array (make-interval '#(0)) list)))) ) - '(test-group "assign/product" - (do ((d 1 (fx+ d 1))) - ((= d 6)) - (let* ((unsafe-specialized-destination - (make-specialized-array (make-interval (make-vector d 10)) - u1-storage-class)) - (safe-specialized-destination - (make-specialized-array (make-interval (make-vector d 10)) - u1-storage-class - #t)) - (mutable-destination - (make-array (array-domain safe-specialized-destination) - (array-getter safe-specialized-destination) - (array-setter safe-specialized-destination))) - (source - (make-array (array-domain safe-specialized-destination) - (lambda args 100)))) ;; not 0 or 1 - (test-error (array-assign! unsafe-specialized-destination source)) - (test-error (array-assign! safe-specialized-destination source)) - (test-error (array-assign! mutable-destination source)))) - + (test-group "assign/product" (do ((i 0 (fx+ i 1))) ((fx=? i tests)) (let* ((interval @@ -3577,6 +3557,7 @@ (test-error (interval-cartesian-product 'a)) (test-error (interval-cartesian-product (make-interval '#(0) '#(1)) 'a)) + (test (make-interval '#()) (interval-cartesian-product)) (do ((i 0 (+ i 1))) ((= i tests))