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:
parent
aaeb4e5bfb
commit
82c481dd11
1 changed files with 32 additions and 0 deletions
|
@ -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
|
||||
;;;
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue