1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00

array-contents returns root for empty arrays with empty root

This fixes a compiler issue where (uniform-array->bytevector #2f64())
failed because of the stricter definition of uniform-vector? on this branch.

Perhaps it would be better if uniform-array->bytevector didn't require
a contiguous argument.

* libguile/arrays.c: (scm_array_contents): return the root regardless of
  the value of SCM_I_ARRAY_DIMS (ra)->inc.
* test-suite/tests/arrays.test: check.
This commit is contained in:
Daniel Llorens 2013-05-08 16:06:40 +02:00 committed by Andy Wingo
parent c6eaad9757
commit 2c1ccb02c5
2 changed files with 7 additions and 3 deletions

View file

@ -589,9 +589,8 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
}
v = SCM_I_ARRAY_V (ra);
if ((len == scm_c_array_length (v)) && (0 == SCM_I_ARRAY_BASE (ra))
&& SCM_I_ARRAY_DIMS (ra)->inc)
return v;
if ((len == scm_c_array_length (v)) && (0 == SCM_I_ARRAY_BASE (ra)))
return v;
else
{
SCM sra = scm_i_make_array (1);

View file

@ -325,6 +325,11 @@
(let* ((a (make-array 0 4 4)))
(not (array-contents (transpose-array a 1 0) #t))))
;; This is a consequence of (array-contents? a #t) => #t.
(pass-if "empty array"
(let ((a (make-typed-array 'f64 2 0 0)))
(f64vector? (array-contents a))))
(pass-if "broadcast vector I"
(let* ((a (make-array 0 4))
(b (make-shared-array a (lambda (i j k) (list k)) 1 1 4)))