1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00

Tests for transpose-array

* test-suite/tests/arrays.test: test transpose-array for ranks 1, 2, 3.
This commit is contained in:
Daniel Llorens 2013-04-10 14:53:10 +02:00 committed by Andy Wingo
parent aaeb4e5bfb
commit 82c481dd11

View file

@ -602,6 +602,38 @@
(b (make-shared-array a amap2 2 2)))
(eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
;;;
;;; transpose-array
;;;
(with-test-prefix "transpose-array"
(pass-if "rank 1"
(let* ((a #(1 2 3))
(b (transpose-array a 0)))
(and (array-equal? a b)
(eq? (shared-array-root a) (shared-array-root b)))))
(pass-if "rank 2"
(let* ((a #2((1 2 3) (4 5 6)))
(b (transpose-array a 1 0))
(c (transpose-array a 0 1)))
(and (array-equal? b #2((1 4) (2 5) (3 6)))
(array-equal? c a)
(eq? (shared-array-root a)
(shared-array-root b)
(shared-array-root c)))))
; rank > 2 is needed to check against the inverted axis index logic.
(pass-if "rank 3"
(let* ((a #3(((0 1 2 3) (4 5 6 7) (8 9 10 11))
((12 13 14 15) (16 17 18 19) (20 21 22 23))))
(b (transpose-array a 1 2 0)))
(and (array-equal? b #3(((0 4 8) (12 16 20)) ((1 5 9) (13 17 21))
((2 6 10) (14 18 22)) ((3 7 11) (15 19 23))))
(eq? (shared-array-root a)
(shared-array-root b))))))
;;;
;;; uniform-vector
;;;