Fix scm_ramapc bugs with 0-inc arrays

* libguile/array-map.c: (scm_ramapc): Cannot flag empty on the product
  inc * dim * dim ... Check every dim.
* test-suite/tests/ramap.test: Tests the 0-inc, non empty case for both
  array-map! and array-copy!.

2 files changed, 35 insertions, 24 deletions

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 70e3e676f..7d3aced22 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -130,18 +130,19 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
         {
           ssize_t inc = SCM_I_ARRAY_DIMS (ra0)[k].inc;
           do {
-            inc *= (UBND (ra0, k) - LBND (ra0, k) + 1);
+            ssize_t dim = (UBND (ra0, k) - LBND (ra0, k) + 1);
+            empty = empty || (0 == dim);
+            inc *= dim;
             --k;
           } while (k >= 0 && inc == SCM_I_ARRAY_DIMS (ra0)[k].inc);
           kroll = k+1;
-          empty = 0 == inc;
         }
       else
         kroll = 0;
 
       /* Check emptiness of not-unrolled axes. */
-      for (; k>=0 && !empty; --k)
-        empty = (0 == (UBND (ra0, k) - LBND (ra0, k) + 1));
+      for (; k>=0; --k)
+        empty = empty || (0 == (UBND (ra0, k) - LBND (ra0, k) + 1));
     }
   else
     {
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index db9d4e145..950f65925 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -112,6 +112,23 @@
       (array-copy! a b)
       (array-equal? b #3(((1 2) (3 4) (0 0)) ((5 6) (7 8) (0 0))))))
 
+  (pass-if "rank 0"
+    (let ((a #0(99))
+          (b (make-array 0)))
+      (array-copy! a b)
+      (equal? b #0(99))))
+
+  (pass-if "rank 1"
+    (let* ((a #2((1 2) (3 4)))
+           (b (make-shared-array a (lambda (j) (list 1 j)) 2))
+           (c (make-shared-array a (lambda (i) (list (- 1 i) 1)) 2))
+           (d (make-array 0 2))
+           (e (make-array 0 2)))
+      (array-copy! b d)
+      (array-copy! c e)
+      (and (equal? d #(3 4))
+           (equal? e #(4 2)))))
+
   (pass-if "rank 2"
     (let ((a #2((1 2) (3 4)))
           (b (make-array 0 2 2))
@@ -136,27 +153,15 @@
           (piece (lambda (X w s)
                    (make-shared-array
                     X (lambda (i j) (list i (+ j s))) 3 w))))
-      (array-map! A (piece X 2 0))
-      (array-map! B (piece X 2 2))
-      (array-map! C (piece X 1 4))
+      (array-copy! A (piece X 2 0))
+      (array-copy! B (piece X 2 2))
+      (array-copy! C (piece X 1 4))
       (and (array-equal? X #2((0 1 10 11 20) (2 3 12 13 21) (4 5 14 15 22))))))
 
-  (pass-if "rank 1"
-    (let* ((a #2((1 2) (3 4)))
-           (b (make-shared-array a (lambda (j) (list 1 j)) 2))
-           (c (make-shared-array a (lambda (i) (list (- 1 i) 1)) 2))
-           (d (make-array 0 2))
-           (e (make-array 0 2)))
-      (array-copy! b d)
-      (array-copy! c e)
-      (and (equal? d #(3 4))
-           (equal? e #(4 2)))))
-
-  (pass-if "rank 0"
-    (let ((a #0(99))
-          (b (make-array 0)))
-      (array-copy! a b)
-      (equal? b #0(99)))))
+  (pass-if "null increments, not empty"
+    (let ((a (make-array 0 2 2)))
+      (array-copy! (make-shared-array #0(1) (lambda x '()) 2 2) a)
+      (array-equal? #2((1 1) (1 1))))))
 
 ;;;
 ;;; array-map!
@@ -276,7 +281,12 @@
         (array-map! (piece X 2 0) values A)
         (array-map! (piece X 2 2) values B)
         (array-map! (piece X 1 4) values C)
-        (and (array-equal? X #2((0 1 10 11 20) (2 3 12 13 21) (4 5 14 15 22)))))))
+        (and (array-equal? X #2((0 1 10 11 20) (2 3 12 13 21) (4 5 14 15 22))))))
+
+    (pass-if "null increments, not empty"
+      (let ((a (make-array 0 2 2)))
+        (array-map! a values (make-shared-array #0(1) (lambda x '()) 2 2))
+        (array-equal? a #2((1 1) (1 1))))))
 
   (with-test-prefix "two sources"