mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-19 11:10:25 +02:00
Code Activity

Changes from arch/CVS synchronization

Browse source
This commit is contained in:
Ludovic Courtès 2006-12-12 14:09:08 +00:00
parent 4d2e2c729b
commit 2ef21bf169
4 changed files with 66 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

6
test-suite/ChangeLog
View file

@ -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.

38
test-suite/tests/unif.test
View file

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