summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2006-12-12 14:01:40 +0000
committerLudovic Courtès <ludo@gnu.org>2006-12-12 14:01:40 +0000
commitf30e1bdf97ae8b2b2918da585f887a4d3a23a347 (patch)
tree5a6612e2fdbfe5fb49caec0fbb36dbc12403345a
parent22be72d35f90fa94f5dd09444cd891e2bb963cc8 (diff)
downloadguile-f30e1bdf97ae8b2b2918da585f887a4d3a23a347.tar.gz
Changes from arch/CVS synchronization
-rw-r--r--libguile/ChangeLog13
-rw-r--r--libguile/unif.c14
-rw-r--r--test-suite/ChangeLog6
-rw-r--r--test-suite/tests/unif.test38
4 files changed, 66 insertions, 5 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index e0a50633e..8ba446c6c 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,16 @@
+2006-12-12 Ludovic Courtès <ludovic.courtes@laas.fr>
+
+ * libguile/unif.c (read_decimal_integer): Let RESP be SIGN * RES
+ instead of RES (reported by Gyula Szavai). This allows the use of
+ negative lower bounds.
+ (scm_i_read_array): Make sure LEN is non-negative (reported by
+ Gyula Szavai).
+
+ (scm_array_in_bounds_p): Iterate over S instead of always
+ comparing indices with the bounds of S[0]. This fixes
+ `array-in-bounds?' for arrays with a rank greater than one and
+ with different lower bounds for each dimension.
+
2006-11-29 Ludovic Courtès <ludovic.courtes@laas.fr>
* libguile/vectors.c (scm_vector_to_list): Fixed list
diff --git a/libguile/unif.c b/libguile/unif.c
index 7f01f62dd..d61532bb0 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -1150,10 +1150,10 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
{
- size_t k = SCM_I_ARRAY_NDIM (v);
+ size_t k, ndim = SCM_I_ARRAY_NDIM (v);
scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
- while (k > 0)
+ for (k = 0; k < ndim; k++)
{
long ind;
@@ -1161,9 +1161,8 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
SCM_WRONG_NUM_ARGS ();
ind = scm_to_long (SCM_CAR (args));
args = SCM_CDR (args);
- k -= 1;
- if (ind < s->lbnd || ind > s->ubnd)
+ if (ind < s[k].lbnd || ind > s[k].ubnd)
{
res = SCM_BOOL_F;
/* We do not stop the checking after finding a violation
@@ -2669,7 +2668,7 @@ read_decimal_integer (SCM port, int c, ssize_t *resp)
}
if (got_it)
- *resp = res;
+ *resp = sign * res;
return c;
}
@@ -2753,6 +2752,11 @@ scm_i_read_array (SCM port, int c)
{
c = scm_getc (port);
c = read_decimal_integer (port, c, &len);
+ if (len < 0)
+ scm_i_input_error (NULL, port,
+ "array length must be non-negative",
+ SCM_EOL);
+
s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
}
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index aad8a1c0e..cd2141c0d 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,9 @@
+2006-12-12 Ludovic Courtès <ludovic.courtes@laas.fr>
+
+ * tests/unif.test (syntax): New test prefix. Check syntax for
+ negative lower bounds and negative lengths (reported by Gyula
+ Szavai) as well as `array-in-bounds?'.
+
2006-11-29 Ludovic Courtès <ludovic.courtes@laas.fr>
* test-suite/tests/vectors.test: Use `define-module'.
diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test
index 2a0048483..576a9286c 100644
--- a/test-suite/tests/unif.test
+++ b/test-suite/tests/unif.test
@@ -26,6 +26,10 @@
(define exception:wrong-num-indices
(cons 'misc-error "^wrong number of indices.*"))
+(define exception:length-non-negative
+ (cons 'read-error ".*array length must be non-negative.*"))
+
+
(with-test-prefix "array?"
(let ((bool (make-typed-array 'b #t '(5 6)))
@@ -513,7 +517,41 @@
(array-set! a -128 0)
(= -128 (uniform-vector-ref a 0)))))))
+;;;
+;;; syntax
+;;;
+
+(with-test-prefix "syntax"
+
+ (pass-if "rank and lower bounds"
+ ;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8.
+ (let ((a '#2u32@2@7((1 2) (3 4))))
+ (and (array? a)
+ (typed-array? a 'u32)
+ (= (array-rank a) 2)
+ (let loop ((bounds '((2 7) (2 8) (3 7) (3 8)))
+ (result #t))
+ (if (null? bounds)
+ result
+ (and result
+ (loop (cdr bounds)
+ (apply array-in-bounds? a (car bounds)))))))))
+
+ (pass-if "negative lower bound"
+ (let ((a '#1@-3(a b)))
+ (and (array? a)
+ (= (array-rank a) 1)
+ (array-in-bounds? a -3) (array-in-bounds? a -2)
+ (eq? 'a (array-ref a -3))
+ (eq? 'b (array-ref a -2)))))
+
+ (pass-if-exception "negative length" exception:length-non-negative
+ (with-input-from-string "'#1:-3(#t #t)" read)))
+
+
+;;;
;;; equal? with vector and one-dimensional array
+;;;
(pass-if "vector equal? one-dimensional array"
(equal? (make-shared-array #2((a b c) (d e f) (g h i))