Fix compilation errors when reading arrays at the repl

* compile-assembly.scm
  - vector-fold2: handle rank 1 arrays, since this is called with
    the result of array-contents which need not be a vector.
  - dump-constants: fix uses of vector-fold2. Replace vector-length
    on result of array-contents by array-length.
* libguile/arrays.c
  - scm_array_contents: branch cases not on scm_is_generalized_vector but
    on SCM_I_ARRAYP. Thus lbnd!=0, which could happen with
    scm_is_generalized_vector, never appears in the output.
* test-suite/tests/arrays.test
  - tests for array-contents.

2 files changed, 83 insertions, 22 deletions

diff --git a/libguile/arrays.c b/libguile/arrays.c
index a743cfe8c..e86a620ae 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -562,15 +562,13 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
 	    "contiguous in memory.")
 #define FUNC_NAME s_scm_array_contents
 {
-  SCM sra;
-
-  if (scm_is_generalized_vector (ra))
-    return ra;
-
-  if (SCM_I_ARRAYP (ra))
+  if (!scm_is_array (ra))
+    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+  else if (SCM_I_ARRAYP (ra))
     {
+      SCM v;
       size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
-      if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
+      if (!SCM_I_ARRAY_CONTP (ra))
 	return SCM_BOOL_F;
       for (k = 0; k < ndim; k++)
 	len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
@@ -587,23 +585,23 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
 	    }
 	}
 
-      {
-	SCM v = SCM_I_ARRAY_V (ra);
-	size_t length = scm_c_array_length (v);
-	if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
-	  return v;
-      }
-
-      sra = scm_i_make_array (1);
-      SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
-      SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
-      SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
-      SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
-      return sra;
+      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;
+      else
+        {
+          SCM sra = scm_i_make_array (1);
+          SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
+          SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
+          SCM_I_ARRAY_V (sra) = v;
+          SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
+          SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
+          return sra;
+        }
     }
   else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+    return ra;
 }
 #undef FUNC_NAME
 
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 7b7471543..88ae00a10 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -290,6 +290,69 @@
 	   (eqv? 8 (array-ref s2 2))))))
 
 ;;;
+;;; array-contents
+;;;
+
+(with-test-prefix "array-contents"
+
+  (define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2))
+
+  (pass-if "simple vector"
+    (let* ((a (make-array 0 4)))
+      (eq? a (array-contents a))))
+
+  (pass-if "offset vector"
+    (let* ((a (make-array 0 '(1 4))))
+      (array-copy! #(1 2 3 4) (array-contents a))
+      (array-equal? #1@1(1 2 3 4) a)))
+
+  (pass-if "offset vector, strict"
+    (let* ((a (make-array 0 '(1 4))))
+      (array-copy! #(1 2 3 4) (array-contents a #t))
+      (array-equal? #1@1(1 2 3 4) a)))
+
+  (pass-if "stepped vector"
+    (let* ((a (make-array 0 4)))
+      (array-copy! #(99 66) (array-contents (every-two a)))
+      (array-equal? #(99 0 66 0) a)))
+
+  ;; this failed in 2.0.9.
+  (pass-if "stepped vector, strict"
+    (let* ((a (make-array 0 4)))
+      (not (array-contents (every-two a) #t))))
+
+  (pass-if "plain rank 2 array"
+    (let* ((a (make-array 0 2 2)))
+      (array-copy! #(1 2 3 4) (array-contents a #t))
+      (array-equal? #2((1 2) (3 4)) a)))
+
+  (pass-if "offset rank 2 array"
+    (let* ((a (make-array 0 '(1 2) '(1 2))))
+      (array-copy! #(1 2 3 4) (array-contents a #t))
+      (array-equal? #2@1@1((1 2) (3 4)) a)))
+
+  (pass-if "transposed rank 2 array"
+    (let* ((a (make-array 0 4 4)))
+      (not (array-contents (transpose-array a 1 0) #t))))
+
+  (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)))
+      (array-copy! #(1 2 3 4) (array-contents b #t))
+      (array-equal? #(1 2 3 4) a)))
+
+  (pass-if "broadcast vector II"
+    (let* ((a (make-array 0 4))
+           (b (make-shared-array a (lambda (i j k) (list k)) 2 1 4)))
+      (not (array-contents b))))
+
+  ;; FIXME maybe this should be allowed.
+  (pass-if "broadcast vector -> empty"
+    (let* ((a (make-array 0 4))
+           (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
+      (if #f #f))))
+
+;;;
 ;;; shared-array-root
 ;;;