1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00

Check more cases of array-contents

* libguile/arrays.c: (scm_array_contents): fix comment.
* test-suite/tests/arrays.test: add cases that depend on correct
  setting of CONTIGUOUS_FLAG.
This commit is contained in:
Daniel Llorens 2013-04-24 17:13:56 +02:00 committed by Andy Wingo
parent c545f7164a
commit 35f45ed6d0
2 changed files with 12 additions and 3 deletions

View file

@ -548,8 +548,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
/* attempts to unroll an array into a one-dimensional array. /* attempts to unroll an array into a one-dimensional array.
returns the unrolled array or #f if it can't be done. */ returns the unrolled array or #f if it can't be done. */
/* if strict is not SCM_UNDEFINED, return #f if returned array /* if strict is true, return #f if returned array
wouldn't have contiguous elements. */ wouldn't have contiguous elements. */
SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
(SCM ra, SCM strict), (SCM ra, SCM strict),
"If @var{ra} may be @dfn{unrolled} into a one dimensional shared\n" "If @var{ra} may be @dfn{unrolled} into a one dimensional shared\n"

View file

@ -342,7 +342,16 @@
(let* ((a (make-array 0 4)) (let* ((a (make-array 0 4))
(b (make-shared-array a (lambda (i j k) (list k)) 0 1 4))) (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
(if #f #f))) (if #f #f)))
)
(pass-if "broadcast 2-rank I"
(let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list 0 j)) 2 3)))
(not (array-contents b))))
(pass-if "broadcast 2-rank I"
(let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list i 0)) 2 3)))
(not (array-contents b)))))
;;; ;;;
;;; shared-array-root ;;; shared-array-root