From 2ef21bf169000aa473011f47b233bcbc776bab86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 12 Dec 2006 14:09:08 +0000 Subject: [PATCH] Changes from arch/CVS synchronization --- libguile/ChangeLog | 13 +++++++++++++ libguile/unif.c | 14 +++++++++----- test-suite/ChangeLog | 6 ++++++ test-suite/tests/unif.test | 38 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 66 insertions(+), 5 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 854827240..2d81480a9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,16 @@ +2006-12-12 Ludovic Courtès + + * 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-12-05 Kevin Ryde * numbers.c (scm_product): For flonum*inum and complex*inum, return 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 02ef96f7f..3790f69b2 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2006-12-12 Ludovic Courtès + + * 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-12-09 Kevin Ryde * standalone/test-use-srfi: New test. 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))