mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Tests for array-copy!

Browse source 
* test-suite/tests/arrays.test: tests for arguments of rank 0, 1 and 2.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Daniel Llorens 2013-04-03 22:31:47 +02:00 • committed by Ludovic Courtès
parent 55e26a49db
commit b5159a471a
1 changed files with 40 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

40
test-suite/tests/arrays.test
View file

@ -293,6 +293,46 @@
(pass-if "-123" (array-fill! a -123) #t)
(pass-if "5/8" (array-fill! a 5/8) #t))))
;;;
;;; array-copy!
;;;
(with-test-prefix "array-copy!"
(pass-if "rank 2"
(let ((a #2((1 2) (3 4)))
(b (make-array 0 2 2))
(c (make-array 0 2 2))
(d (make-array 0 2 2))
(e (make-array 0 2 2)))
(array-copy! a b)
(array-copy! a (transpose-array c 1 0))
(array-copy! (transpose-array a 1 0) d)
(array-copy! (transpose-array a 1 0) (transpose-array e 1 0))
(and (equal? a #2((1 2) (3 4)))
(equal? b #2((1 2) (3 4)))
(equal? c #2((1 3) (2 4)))
(equal? d #2((1 3) (2 4)))
(equal? e #2((1 2) (3 4))))))
(pass-if "rank 1"
(let* ((a #2((1 2) (3 4)))
(b (make-shared-array a (lambda (j) (list 1 j)) 2))
(c (make-shared-array a (lambda (i) (list (- 1 i) 1)) 2))
(d (make-array 0 2))
(e (make-array 0 2)))
(array-copy! b d)
(array-copy! c e)
(and (equal? d #(3 4))
(equal? e #(4 2)))))
(pass-if "rank 0"
(let ((a #0(99))
(b (make-array 0)))
(array-copy! a b)
(equal? b #0(99)))))
;;;
;;; array-in-bounds?
;;;