Changes from arch/CVS synchronization

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-12-05  Kevin Ryde  <user42@zip.com.au>
 
 	* numbers.c (scm_product): For flonum*inum and complex*inum, return

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));
 	    }
 

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-12-09  Kevin Ryde  <user42@zip.com.au>
 
 	* standalone/test-use-srfi: New test.

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))