Fix some array-tile domain assertions.

Closes #966.

Fix complements of Bradley Lucier.
This commit is contained in:
Alex Shinn 2024-05-26 22:04:22 +09:00
parent 953f3ada23
commit db53df7df4
2 changed files with 15 additions and 3 deletions

View file

@ -3038,6 +3038,12 @@
(test-error
(array-tile (make-array (make-interval '#(0 0) '#(10 10)) list)
'#(-10 20)))
(test-error
(array-tile (make-array (make-interval '#(4)) list) '#(#(0 3 0 -1 2))))
(test-error
(array-tile (make-array (make-interval '#(0)) list) '#(2)))
(test-error
(array-tile (make-array (make-interval '#(0)) list) '#(#())))
(let* ((TA '(( 1 2 3 4 5 6)
( 7 8 9 10 11 12)

View file

@ -159,9 +159,15 @@
sizes)))
(assert
(vector-every (lambda (s len)
(if (exact-integer? s)
(positive? s)
(= (vector-fold + 0 s) len)))
(if (zero? len)
(and (vector? s)
(not (zero? (vector-length s)))
(vector-every zero? s))
(or (and (exact-integer? s)
(positive? s))
(and (vector? s)
(not (vector-any negative? s))
(= (vector-fold + 0 s) len)))))
sizes
(interval-widths (array-domain array))))
(let ((domain (make-interval