mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 18:40:22 +02:00
Code Activity

(array-fill!): Exercise byte range and type checks.

Browse source
This commit is contained in:
Kevin Ryde 2004-08-06 01:06:55 +00:00
parent bc91b91e8f
commit e22b2890ed
1 changed files with 80 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -196,12 +196,52 @@
(pass-if "complex" (eq? #f (array? complex '()))) (pass-if "complex" (eq? #f (array? complex '())))
(pass-if "scm" (eq? #t (array? scm '())))))) (pass-if "scm" (eq? #t (array? scm '()))))))
;;;
;;; array-fill!
;;;
(with-test-prefix "array-fill!"
(with-test-prefix "byte"
(let ((a (make-uniform-vector 1 #\nul)))
(pass-if "0" (array-fill! a 0) #t)
(pass-if "127" (array-fill! a 127) #t)
(pass-if "-128" (array-fill! a -128) #t)
(pass-if-exception "128" exception:out-of-range
(array-fill! a 128))
(pass-if-exception "-129" exception:out-of-range
(array-fill! a -129))
(pass-if-exception "symbol" exception:wrong-type-arg
(array-fill! a 'symbol)))))
;;; ;;;
;;; array-set! ;;; array-set!
;;; ;;;
(with-test-prefix "array-set!" (with-test-prefix "array-set!"
(with-test-prefix "byte"
(let ((a (make-uniform-array #\nul 1)))
(pass-if "-128"
(begin (array-set! a -128 0) #t))
(pass-if "0"
(begin (array-set! a 0 0) #t))
(pass-if "127"
(begin (array-set! a 127 0) #t))
(pass-if-exception "-129" exception:out-of-range
(begin (array-set! a -129 0) #t))
(pass-if-exception "128" exception:out-of-range
(begin (array-set! a 128 0) #t))
(pass-if "#\\nul"
(begin (array-set! a #\nul 0) #t))
(pass-if "#\\del"
(begin (array-set! a #\del 0) #t))
(pass-if "char 255"
(begin (array-set! a (integer->char 255) 0) #t))))
(with-test-prefix "short" (with-test-prefix "short"
(let ((a (make-uniform-array 's 1))) (let ((a (make-uniform-array 's 1)))
@ -271,3 +311,43 @@
(uniform-array-set1! a 'y '(4 . 8))) (uniform-array-set1! a 'y '(4 . 8)))
(pass-if-exception "three improper indexes" exception:wrong-num-args (pass-if-exception "three improper indexes" exception:wrong-num-args
(uniform-array-set1! a 'y '(4 8 . 0)))))) (uniform-array-set1! a 'y '(4 8 . 0))))))
;;;
;;; uniform-vector-ref
;;;
(with-test-prefix "uniform-vector-ref"
(with-test-prefix "byte"
(let ((a (make-uniform-array #\nul 1)))
(pass-if "0"
(begin
(array-set! a 0 0)
(= 0 (uniform-vector-ref a 0))))
(pass-if "127"
(begin
(array-set! a 127 0)
(= 127 (uniform-vector-ref a 0))))
(pass-if "-128"
(begin
(array-set! a -128 0)
(= -128 (uniform-vector-ref a 0))))
(pass-if "#\\nul"
(begin
(array-set! a #\nul 0)
(= 0 (uniform-vector-ref a 0))))
(pass-if "#\\del"
(begin
(array-set! a #\del 0)
(= 127 (uniform-vector-ref a 0))))
(pass-if "char 255"
(begin
(array-set! a (integer->char 255) 0)
(= -1 (uniform-vector-ref a 0))))
(pass-if "char 128"
(begin
(array-set! a (integer->char 128) 0)
(= -128 (uniform-vector-ref a 0)))))))