Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +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) (interval-ub iv)
scales))) scales)))
(define (interval-cartesian-product iv0 . o) (define (interval-cartesian-product . o)
(make-interval (apply vector-append (map interval-lb (cons iv0 o))) (assert (every interval? o))
(apply vector-append (map interval-ub (cons iv0 o))))) (make-interval (apply vector-append (map interval-lb o))
(apply vector-append (map interval-ub o))))
;; Storage Classes ;; Storage Classes

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

@ -3346,27 +3346,7 @@
(make-array (make-interval '#(0)) list)))) (make-array (make-interval '#(0)) list))))
) )
'(test-group "assign/product" (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))))
(do ((i 0 (fx+ i 1))) (do ((i 0 (fx+ i 1)))
((fx=? i tests)) ((fx=? i tests))
(let* ((interval (let* ((interval
@ -3577,6 +3557,7 @@
(test-error (interval-cartesian-product 'a)) (test-error (interval-cartesian-product 'a))
(test-error (interval-cartesian-product (make-interval '#(0) '#(1)) 'a)) (test-error (interval-cartesian-product (make-interval '#(0) '#(1)) 'a))
(test (make-interval '#()) (interval-cartesian-product))
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((= i tests)) ((= i tests))