diff options
author | Ludovic Courtès <ludo@gnu.org> | 2006-12-12 14:01:40 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2006-12-12 14:01:40 +0000 |
commit | f30e1bdf97ae8b2b2918da585f887a4d3a23a347 (patch) | |
tree | 5a6612e2fdbfe5fb49caec0fbb36dbc12403345a | |
parent | 22be72d35f90fa94f5dd09444cd891e2bb963cc8 (diff) | |
download | guile-f30e1bdf97ae8b2b2918da585f887a4d3a23a347.tar.gz |
Changes from arch/CVS synchronization
-rw-r--r-- | libguile/ChangeLog | 13 | ||||
-rw-r--r-- | libguile/unif.c | 14 | ||||
-rw-r--r-- | test-suite/ChangeLog | 6 | ||||
-rw-r--r-- | test-suite/tests/unif.test | 38 |
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)) |