summaryrefslogtreecommitdiff
path: root/test-suite
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2015-09-08 16:57:30 +0200
committerDaniel Llorens <daniel.llorens@bluewin.ch>2016-11-23 13:04:49 +0100
commit7ef9d0ac2bd7af119212d659e94906ae9aa93a8f (patch)
tree96e28792f1de1b3ac4697cd291e9aa77f0c9cae4 /test-suite
parentd1435ea6bdaa3c56d7f025f13d1e7d78c4d9b748 (diff)
New functions (array-for-each-cell, array-for-each-cell-in-order)
* libguile/array-map.c (scm_i_array_rebase, scm_array_for_each_cell): New functions. Export scm_array_for_each_cell() as (array-for-each-cell). (array-for-each-cell-in-order): Define additional export. * libguile/array-map.h (scm_i_array_rebase, scm_array_for_each_cell): Add prototypes. * test-suite/tests/array-map.test: Renamed from test-suite/tests/ramap.test, fix module name. Add tests for (array-for-each-cell). * test-suite/Makefile.am: Apply rename array-map.test -> ramap.test.
Diffstat (limited to 'test-suite')
-rw-r--r--test-suite/Makefile.am2
-rw-r--r--test-suite/tests/array-map.test (renamed from test-suite/tests/ramap.test)35
2 files changed, 34 insertions, 3 deletions
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index f940d78c7..98cc5f026 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -115,7 +115,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/r6rs-records-syntactic.test \
tests/r6rs-unicode.test \
tests/rnrs-libraries.test \
- tests/ramap.test \
+ tests/array-map.test \
tests/random.test \
tests/rdelim.test \
tests/reader.test \
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/array-map.test
index bd8a434bd..3095b78f4 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/array-map.test
@@ -1,4 +1,4 @@
-;;;; ramap.test --- test array mapping functions -*- scheme -*-
+;;;; array-map.test --- test array mapping functions -*- scheme -*-
;;;;
;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 Free Software Foundation, Inc.
;;;;
@@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-(define-module (test-suite test-ramap)
+(define-module (test-suite test-array-map)
#:use-module (test-suite lib))
(define exception:shape-mismatch
@@ -507,3 +507,34 @@
(b (make-typed-array 'f64 0 0 2))
(c (make-typed-array 'f64 0 2 0)))
(array-for-each (lambda (b c) (set! a (cons* b c a))) b c)))))
+
+;;;
+;;; array-for-each-cell
+;;;
+
+(with-test-prefix "array-for-each-cell"
+
+ (pass-if-equal "1 argument frame rank 1"
+ #2((1 3 9) (2 7 8))
+ (let* ((a (list->array 2 '((9 1 3) (7 8 2)))))
+ (array-for-each-cell 1 (lambda (a) (sort! a <)) a)
+ a))
+
+ (pass-if-equal "2 arguments frame rank 1"
+ #f64(8 -1)
+ (let* ((x (list->typed-array 'f64 2 '((9 1) (7 8))))
+ (y (f64vector 99 99)))
+ (array-for-each-cell 1 (lambda (y x) (array-set! y (- (array-ref x 0) (array-ref x 1)))) y x)
+ y))
+
+ (pass-if-equal "regression: zero-sized frame loop without unrolling"
+ 99
+ (let* ((x 99)
+ (o (make-array 0. 0 3 2)))
+ (array-for-each-cell 2
+ (lambda (o a0 a1)
+ (set! x 0))
+ o
+ (make-shared-array (make-array 1. 0 1) (const '(0 0)) 0 3)
+ (make-array 2. 0 3))
+ x)))