interval-cartesian-product should accept zero args

Closes #983.
ashinn · May 29, 2024 · b5de5ec · b5de5ec
1 parent e737e48
commit b5de5ec
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 24 deletions.
diff --git 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
@@ -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))