* added an (ikarus system $bytevectors) library

This commit is contained in:
Abdulaziz Ghuloum 2007-05-15 12:29:47 -04:00
parent 97f59ad1ee
commit 9d3e23fb6d
34 changed files with 61 additions and 0 deletions

Binary file not shown.

View File

@ -126,6 +126,12 @@
[$string-length 1 value]
[$string-ref 2 value]
[$string-set! 3 effect]
;;; bytevectors
[bytevector? 1 pred]
[$make-bytevector 1 value]
[$bytevector-length 1 value]
[$bytevector-ref 2 value]
[$bytevector-set! 3 effect]
;;; symbols
[$make-symbol 1 value]
[$symbol-value 1 value]

View File

@ -117,6 +117,7 @@
[$chars (ikarus system $chars) #f]
[$strings (ikarus system $strings) #f]
[$vectors (ikarus system $vectors) #f]
[$bytes (ikarus system $bytevectors) #f]
[$fx (ikarus system $fx) #f]
[$symbols (ikarus system $symbols) #f]
[$records (ikarus system $records) #f]
@ -130,6 +131,7 @@
[$boot (ikarus system $bootstrap) #f]
))
(define bootstrap-collection
(let ([ls (map
(lambda (x)
@ -469,6 +471,14 @@
[$string-set! $strings]
[$string-length $strings]
[bytevector? i]
[$make-bytevector $bytes]
[$bytevector-length $bytes]
[$bytevector-ref $bytes]
[$bytevector-set! $bytes]
[$make-vector $vectors]
[$vector-length $vectors]
[$vector-ref $vectors]

7
src/run-tests.ss Executable file
View File

@ -0,0 +1,7 @@
#!/usr/bin/env ikarus --r6rs-script
(import (ikarus)
(tests bytevectors))
(test-bytevectors)
(printf "Happy Happy Joy Joy\n")

23
src/tests/bytevectors.ss Normal file
View File

@ -0,0 +1,23 @@
(library (tests bytevectors)
(export test-bytevectors)
(import (ikarus) (tests framework))
(define (not-byte-vector? x)
(not (bytevector? x)))
(define-tests test-bytevectors
[bytevector? (make-bytevector 1)]
[bytevector? (make-bytevector 1 17)]
[bytevector? (make-bytevector 10 -17)]
[not-bytevector? 'foo]
[not-bytevector? "hey"]
[not-bytevector? (current-output-port)]
[not-bytevector? (current-input-port)]
[not-bytevector? '#(2837 2398 239)]
))

15
src/tests/framework.ss Normal file
View File

@ -0,0 +1,15 @@
(library (tests framework)
(export define-tests)
(import (ikarus))
(define-syntax define-tests
(syntax-rules ()
[(_ test-all [p0 e0] ...)
(define test-all
(lambda ()
(let ([p p0] [e e0])
(unless (p e)
(error 'test-all "~s failed, got ~s"
'(p0 e0) e)))
...
(printf "[~s] Happy Happy Joy Joy\n" 'test-all)))])))