mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 23:30:28 +02:00
Code Activity

Check more cases of array-contents

Browse source 
* 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 ebe19774ea
commit 7c78a99f80
2 changed files with 13 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/arrays.c
View file

@ -547,8 +547,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"

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

@ -350,7 +350,17 @@
(pass-if "broadcast vector -> empty" (pass-if "broadcast vector -> empty"
(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