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 shared-array-root

Browse source 
* test-suite/tests/arrays.test: check shared-array-root against
  make-shared-array, array-contents.
This commit is contained in:
Daniel Llorens 2013-04-10 13:45:05 +02:00 • committed by Andy Wingo
parent 2bee653acb
commit 1080ce25bc
1 changed files with 29 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -573,6 +573,35 @@
(and (eqv? 5 (array-ref s2 1))
(eqv? 8 (array-ref s2 2))))))
;;;
;;; shared-array-root
;;;
(with-test-prefix "shared-array-root"
(define amap1 (lambda (i) (list (* 2 i))))
(define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
(pass-if "plain vector"
(let* ((a (make-vector 4 0))
(b (make-shared-array a amap1 2)))
(eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
(pass-if "plain array rank 2"
(let* ((a (make-array 0 4 4))
(b (make-shared-array a amap2 2 2)))
(eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
(pass-if "uniform array rank 2"
(let* ((a (make-typed-array 'c64 0 4 4))
(b (make-shared-array a amap2 2 2)))
(eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
(pass-if "bit array rank 2"
(let* ((a (make-typed-array 'b #f 4 4))
(b (make-shared-array a amap2 2 2)))
(eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
;;;
;;; uniform-vector
;;;