Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

interval-cartesian-product should accept zero args

Browse source 
Closes #983.
This commit is contained in:
Alex Shinn 2024-05-29 09:08:26 +09:00
parent e737e48955
commit b5de5eca92
2 changed files with 6 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lib/srfi/231/base.scm
View file

@ -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

23
lib/srfi/231/test.sld
View file

@ -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))