summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-10 15:28:52 +0200
committerAndy Wingo <wingo@pobox.com>2014-01-27 21:45:17 +0100
commit499a9804c784a92a1dbe51cd3fb45847c29a1c7d (patch)
treed88c368425d3a1c623efaaf971b914d381029f4d
parentb8ff37f5ea4dd762b9b136b6848aba96189b242f (diff)
downloadguile-499a9804c784a92a1dbe51cd3fb45847c29a1c7d.tar.gz
Reorder arrays.test
* test-suite/tests/arrays.test: dependence reordering: first sanity, then make-array, then array-equal?, then make-shared-array, shared-array-root, then the rest, many of which use make-shared-array.
-rw-r--r--test-suite/tests/arrays.test304
1 files changed, 152 insertions, 152 deletions
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 600c29520..0da1a1992 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -6,12 +6,12 @@
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
@@ -207,6 +207,154 @@
(array-equal? #s16(1 2 3) #s16(1 2 3))))
;;;
+;;; make-shared-array
+;;;
+
+(define exception:mapping-out-of-range
+ (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
+
+(with-test-prefix "make-shared-array"
+
+ ;; this failed in guile 1.8.0
+ (pass-if "vector unchanged"
+ (let* ((a (make-array #f '(0 7)))
+ (s (make-shared-array a list '(0 7))))
+ (array-equal? a s)))
+
+ (pass-if-exception "vector, high too big" exception:mapping-out-of-range
+ (let* ((a (make-array #f '(0 7))))
+ (make-shared-array a list '(0 8))))
+
+ (pass-if-exception "vector, low too big" exception:out-of-range
+ (let* ((a (make-array #f '(0 7))))
+ (make-shared-array a list '(-1 7))))
+
+ (pass-if "truncate columns"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2)
+ #2((a b) (d e) (g h))))
+
+ (pass-if "pick one column"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+ (lambda (i) (list i 2))
+ '(0 2))
+ #(c f i)))
+
+ (pass-if "diagonal"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+ (lambda (i) (list i i))
+ '(0 2))
+ #(a e i)))
+
+ ;; this failed in guile 1.8.0
+ (pass-if "2 dims from 1 dim"
+ (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
+ (lambda (i j) (list (+ (* i 3) j)))
+ 4 3)
+ #2((a b c) (d e f) (g h i) (j k l))))
+
+ (pass-if "reverse columns"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+ (lambda (i j) (list i (- 2 j)))
+ 3 3)
+ #2((c b a) (f e d) (i h g))))
+
+ (pass-if "fixed offset, 0 based becomes 1 based"
+ (let* ((x #2((a b c) (d e f) (g h i)))
+ (y (make-shared-array x
+ (lambda (i j) (list (1- i) (1- j)))
+ '(1 3) '(1 3))))
+ (and (eq? (array-ref x 0 0) 'a)
+ (eq? (array-ref y 1 1) 'a))))
+
+ ;; this failed in guile 1.8.0
+ (pass-if "stride every third element"
+ (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
+ (lambda (i) (list (* i 3)))
+ 4)
+ #1(a d g j)))
+
+ (pass-if "shared of shared"
+ (let* ((a #2((1 2 3) (4 5 6) (7 8 9)))
+ (s1 (make-shared-array a (lambda (i) (list i 1)) 3))
+ (s2 (make-shared-array s1 list '(1 2))))
+ (and (eqv? 5 (array-ref s2 1))
+ (eqv? 8 (array-ref s2 2))))))
+
+;;;
+;;; shared-array-root
+;;;
+
+(with-test-prefix "shared-array-root"
+
+ (define amap1 (lambda (i) (list (* 2 i))))
+ (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
+
+ (pass-if "plain vector"
+ (let* ((a (make-vector 4 0))
+ (b (make-shared-array a amap1 2)))
+ (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+ (pass-if "plain array rank 2"
+ (let* ((a (make-array 0 4 4))
+ (b (make-shared-array a amap2 2 2)))
+ (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+ (pass-if "uniform array rank 2"
+ (let* ((a (make-typed-array 'c64 0 4 4))
+ (b (make-shared-array a amap2 2 2)))
+ (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+ (pass-if "bit array rank 2"
+ (let* ((a (make-typed-array 'b #f 4 4))
+ (b (make-shared-array a amap2 2 2)))
+ (eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
+
+;;;
+;;; transpose-array
+;;;
+
+; see strings.test.
+(define exception:wrong-type-arg
+ (cons #t "Wrong type"))
+
+(with-test-prefix "transpose-array"
+
+ (pass-if-exception "non array argument" exception:wrong-type-arg
+ (transpose-array 99))
+
+ (pass-if "rank 0"
+ (let* ((a #0(99))
+ (b (transpose-array a)))
+ (and (array-equal? a b)
+ (eq? (shared-array-root a) (shared-array-root b)))))
+
+ (pass-if "rank 1"
+ (let* ((a #(1 2 3))
+ (b (transpose-array a 0)))
+ (and (array-equal? a b)
+ (eq? (shared-array-root a) (shared-array-root b)))))
+
+ (pass-if "rank 2"
+ (let* ((a #2((1 2 3) (4 5 6)))
+ (b (transpose-array a 1 0))
+ (c (transpose-array a 0 1)))
+ (and (array-equal? b #2((1 4) (2 5) (3 6)))
+ (array-equal? c a)
+ (eq? (shared-array-root a)
+ (shared-array-root b)
+ (shared-array-root c)))))
+
+ ; rank > 2 is needed to check against the inverted axis index logic.
+ (pass-if "rank 3"
+ (let* ((a #3(((0 1 2 3) (4 5 6 7) (8 9 10 11))
+ ((12 13 14 15) (16 17 18 19) (20 21 22 23))))
+ (b (transpose-array a 1 2 0)))
+ (and (array-equal? b #3(((0 4 8) (12 16 20)) ((1 5 9) (13 17 21))
+ ((2 6 10) (14 18 22)) ((3 7 11) (15 19 23))))
+ (eq? (shared-array-root a)
+ (shared-array-root b))))))
+
+;;;
;;; array->list
;;;
@@ -397,8 +545,8 @@
(for-each (lambda (type)
(pass-if (symbol->string type)
(eq? type
- (array-type (make-typed-array type
- *unspecified*
+ (array-type (make-typed-array type
+ *unspecified*
'(5 6))))))
types))))
@@ -500,154 +648,6 @@
(array-set! a 'y 4 8 0)))))
;;;
-;;; make-shared-array
-;;;
-
-(define exception:mapping-out-of-range
- (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
-
-(with-test-prefix "make-shared-array"
-
- ;; this failed in guile 1.8.0
- (pass-if "vector unchanged"
- (let* ((a (make-array #f '(0 7)))
- (s (make-shared-array a list '(0 7))))
- (array-equal? a s)))
-
- (pass-if-exception "vector, high too big" exception:mapping-out-of-range
- (let* ((a (make-array #f '(0 7))))
- (make-shared-array a list '(0 8))))
-
- (pass-if-exception "vector, low too big" exception:out-of-range
- (let* ((a (make-array #f '(0 7))))
- (make-shared-array a list '(-1 7))))
-
- (pass-if "truncate columns"
- (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2)
- #2((a b) (d e) (g h))))
-
- (pass-if "pick one column"
- (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
- (lambda (i) (list i 2))
- '(0 2))
- #(c f i)))
-
- (pass-if "diagonal"
- (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
- (lambda (i) (list i i))
- '(0 2))
- #(a e i)))
-
- ;; this failed in guile 1.8.0
- (pass-if "2 dims from 1 dim"
- (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
- (lambda (i j) (list (+ (* i 3) j)))
- 4 3)
- #2((a b c) (d e f) (g h i) (j k l))))
-
- (pass-if "reverse columns"
- (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
- (lambda (i j) (list i (- 2 j)))
- 3 3)
- #2((c b a) (f e d) (i h g))))
-
- (pass-if "fixed offset, 0 based becomes 1 based"
- (let* ((x #2((a b c) (d e f) (g h i)))
- (y (make-shared-array x
- (lambda (i j) (list (1- i) (1- j)))
- '(1 3) '(1 3))))
- (and (eq? (array-ref x 0 0) 'a)
- (eq? (array-ref y 1 1) 'a))))
-
- ;; this failed in guile 1.8.0
- (pass-if "stride every third element"
- (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
- (lambda (i) (list (* i 3)))
- 4)
- #1(a d g j)))
-
- (pass-if "shared of shared"
- (let* ((a #2((1 2 3) (4 5 6) (7 8 9)))
- (s1 (make-shared-array a (lambda (i) (list i 1)) 3))
- (s2 (make-shared-array s1 list '(1 2))))
- (and (eqv? 5 (array-ref s2 1))
- (eqv? 8 (array-ref s2 2))))))
-
-;;;
-;;; shared-array-root
-;;;
-
-(with-test-prefix "shared-array-root"
-
- (define amap1 (lambda (i) (list (* 2 i))))
- (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
-
- (pass-if "plain vector"
- (let* ((a (make-vector 4 0))
- (b (make-shared-array a amap1 2)))
- (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
-
- (pass-if "plain array rank 2"
- (let* ((a (make-array 0 4 4))
- (b (make-shared-array a amap2 2 2)))
- (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
-
- (pass-if "uniform array rank 2"
- (let* ((a (make-typed-array 'c64 0 4 4))
- (b (make-shared-array a amap2 2 2)))
- (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
-
- (pass-if "bit array rank 2"
- (let* ((a (make-typed-array 'b #f 4 4))
- (b (make-shared-array a amap2 2 2)))
- (eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
-
-;;;
-;;; transpose-array
-;;;
-
-; see strings.test.
-(define exception:wrong-type-arg
- (cons #t "Wrong type"))
-
-(with-test-prefix "transpose-array"
-
- (pass-if-exception "non array argument" exception:wrong-type-arg
- (transpose-array 99))
-
- (pass-if "rank 0"
- (let* ((a #0(99))
- (b (transpose-array a)))
- (and (array-equal? a b)
- (eq? (shared-array-root a) (shared-array-root b)))))
-
- (pass-if "rank 1"
- (let* ((a #(1 2 3))
- (b (transpose-array a 0)))
- (and (array-equal? a b)
- (eq? (shared-array-root a) (shared-array-root b)))))
-
- (pass-if "rank 2"
- (let* ((a #2((1 2 3) (4 5 6)))
- (b (transpose-array a 1 0))
- (c (transpose-array a 0 1)))
- (and (array-equal? b #2((1 4) (2 5) (3 6)))
- (array-equal? c a)
- (eq? (shared-array-root a)
- (shared-array-root b)
- (shared-array-root c)))))
-
- ; rank > 2 is needed to check against the inverted axis index logic.
- (pass-if "rank 3"
- (let* ((a #3(((0 1 2 3) (4 5 6 7) (8 9 10 11))
- ((12 13 14 15) (16 17 18 19) (20 21 22 23))))
- (b (transpose-array a 1 2 0)))
- (and (array-equal? b #3(((0 4 8) (12 16 20)) ((1 5 9) (13 17 21))
- ((2 6 10) (14 18 22)) ((3 7 11) (15 19 23))))
- (eq? (shared-array-root a)
- (shared-array-root b))))))
-
-;;;
;;; uniform-vector
;;;