Don't pre-filter empty arrays in array-append.

Closes #977.
This commit is contained in:
Alex Shinn 2024-05-28 09:35:39 +09:00
parent 11984c6eb3
commit 78a990c73b
2 changed files with 7 additions and 2 deletions

View file

@ -3335,6 +3335,12 @@
(make-interval (quote #(1 -6 -1 3)) (make-interval (quote #(1 -6 -1 3))
(quote #(5 -5 5 8))) (quote #(5 -5 5 8)))
'(3 1 6 2 8 0 8 1 2 6 7 2 9 4 6 5 2 4 5 4 5 2 6 6 0 6 4 2 1 3 4 6 9 6 7 2 4 8 4 3 5 5 8 0 6 4 6 3 7 6 3 4 1 6 2 3 1 9 1 0 3 1 5 0 3 5 8 1 8 0 2 3 1 5 0 4 9 5 3 2 0 7 6 5 5 9 4 8 5 3 2 5 1 4 8 4 5 7 4 6 1 5 8 2 0 1 5 0 8 3 0 4 6 1 7 1 7 1 6 9))))) '(3 1 6 2 8 0 8 1 2 6 7 2 9 4 6 5 2 4 5 4 5 2 6 6 0 6 4 2 1 3 4 6 9 6 7 2 4 8 4 3 5 5 8 0 6 4 6 3 7 6 3 4 1 6 2 3 1 9 1 0 3 1 5 0 3 5 8 1 8 0 2 3 1 5 0 4 9 5 3 2 0 7 6 5 5 9 4 8 5 3 2 5 1 4 8 4 5 7 4 6 1 5 8 2 0 1 5 0 8 3 0 4 6 1 7 1 7 1 6 9)))))
(test-assert
(array-append
0
(list
(make-array (make-interval '#(0)) list)
(make-array (make-interval '#(0)) list))))
) )
'(test-group "assign/product" '(test-group "assign/product"

View file

@ -616,8 +616,7 @@
(pair? arrays) (pair? arrays)
(every array? arrays) (every array? arrays)
(< -1 axis (array-dimension (car arrays))))) (< -1 axis (array-dimension (car arrays)))))
(let* ((arrays (remove array-empty? arrays)) (let* ((a (car arrays))
(a (car arrays))
(a-domain (array-domain a)) (a-domain (array-domain a))
(storage (if (pair? o) (car o) generic-storage-class)) (storage (if (pair? o) (car o) generic-storage-class))
(mutable? (if (and (pair? o) (pair? (cdr o))) (mutable? (if (and (pair? o) (pair? (cdr o)))