From db53df7df44f64f40d4c17f6ceb7c9f5293a9c9e Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 26 May 2024 22:04:22 +0900 Subject: [PATCH] Fix some array-tile domain assertions. Closes #966. Fix complements of Bradley Lucier. --- lib/srfi/231/test.sld | 6 ++++++ lib/srfi/231/transforms.scm | 12 +++++++++--- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld index 93c531f1..8a537974 100644 --- a/lib/srfi/231/test.sld +++ b/lib/srfi/231/test.sld @@ -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) diff --git a/lib/srfi/231/transforms.scm b/lib/srfi/231/transforms.scm index 296fee85..d577bf4b 100644 --- a/lib/srfi/231/transforms.scm +++ b/lib/srfi/231/transforms.scm @@ -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