summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-24 16:34:31 +0200
committerAndy Wingo <wingo@pobox.com>2014-01-27 21:48:02 +0100
commitebe19774eaa2b3d3bb5610f4ba3fdbf9a87ca8c8 (patch)
treeb356442f9c0092f28aa143455a6280561d6e3a29
parentaba084e95e9103843bfbdbd0072c70335529fbb8 (diff)
downloadguile-ebe19774eaa2b3d3bb5610f4ba3fdbf9a87ca8c8.tar.gz
Check the documented matching behavior of array-map!/copy!
* test-suite/tests/arrays.test: move array-copy! tests to ramap.test. * test-suite/tests/ramap.test: check the dissimilar matching behavior of array-copy! and array-map! with arguments of different size.
-rw-r--r--test-suite/tests/arrays.test40
-rw-r--r--test-suite/tests/ramap.test72
2 files changed, 67 insertions, 45 deletions
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 88ae00a10..ce0b4a1b2 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -518,46 +518,6 @@
(equal? a #2((9 0 0) (0 9 0) (0 0 9))))))))
;;;
-;;; array-copy!
-;;;
-
-(with-test-prefix "array-copy!"
-
- (pass-if "rank 2"
- (let ((a #2((1 2) (3 4)))
- (b (make-array 0 2 2))
- (c (make-array 0 2 2))
- (d (make-array 0 2 2))
- (e (make-array 0 2 2)))
- (array-copy! a b)
- (array-copy! a (transpose-array c 1 0))
- (array-copy! (transpose-array a 1 0) d)
- (array-copy! (transpose-array a 1 0) (transpose-array e 1 0))
- (and (equal? a #2((1 2) (3 4)))
- (equal? b #2((1 2) (3 4)))
- (equal? c #2((1 3) (2 4)))
- (equal? d #2((1 3) (2 4)))
- (equal? e #2((1 2) (3 4))))))
-
- (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)))))
-
-
-;;;
;;; array-in-bounds?
;;;
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index 299df9f70..acb0f22d8 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -84,9 +84,57 @@
(array-copy! #2:0:2() c)
(array-equal? #2f64:0:2() c)))
- ;; FIXME add type 'b cases.
-
- ))
+ ;; FIXME add empty, type 'b cases.
+
+ )
+
+ ;; note that it is the opposite of array-map!. This is, unfortunately,
+ ;; documented in the manual.
+
+ (pass-if "matching behavior I"
+ (let ((a #(1 2))
+ (b (make-array 0 3)))
+ (array-copy! a b)
+ (equal? b #(1 2 0))))
+
+ (pass-if-exception "matching behavior II" exception:shape-mismatch
+ (let ((a #(1 2 3))
+ (b (make-array 0 2)))
+ (array-copy! a b)
+ (equal? b #(1 2))))
+
+ (pass-if "rank 2"
+ (let ((a #2((1 2) (3 4)))
+ (b (make-array 0 2 2))
+ (c (make-array 0 2 2))
+ (d (make-array 0 2 2))
+ (e (make-array 0 2 2)))
+ (array-copy! a b)
+ (array-copy! a (transpose-array c 1 0))
+ (array-copy! (transpose-array a 1 0) d)
+ (array-copy! (transpose-array a 1 0) (transpose-array e 1 0))
+ (and (equal? a #2((1 2) (3 4)))
+ (equal? b #2((1 2) (3 4)))
+ (equal? c #2((1 3) (2 4)))
+ (equal? d #2((1 3) (2 4)))
+ (equal? e #2((1 2) (3 4))))))
+
+ (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)))))
;;;
;;; array-map!
@@ -152,7 +200,7 @@
(pass-if-exception "closure 2" exception:wrong-num-args
(array-map! (make-array #f 5) (lambda (x y) #f)
- (make-array #f 5)))
+ (make-array #f 5)))
(pass-if "subr_1"
(let ((a (make-array #f 5)))
@@ -268,7 +316,21 @@
(c (make-array 0 2)))
(begin
(array-map! c + (array-col a 1) (array-row a 1))
- (array-equal? c #(3 6)))))))
+ (array-equal? c #(3 6))))))
+
+ ;; note that array-copy! has the opposite behavior.
+
+ (pass-if-exception "matching behavior I" exception:shape-mismatch
+ (let ((a #(1 2))
+ (b (make-array 0 3)))
+ (array-map! b values a)
+ (equal? b #(1 2 0))))
+
+ (pass-if "matching behavior II"
+ (let ((a #(1 2 3))
+ (b (make-array 0 2)))
+ (array-map! b values a)
+ (equal? b #(1 2)))))
;;;
;;; array-for-each