- Added tests for fasl objects

- fasl-read can now read bignums, flonums, and ratnums.
This commit is contained in:
Abdulaziz Ghuloum 2008-03-09 00:25:03 -05:00
parent 8f0b606609
commit 1943212436
4 changed files with 63 additions and 1 deletions

View File

@ -336,6 +336,34 @@
(vector-set! fields i (vector-set! fields i
(list (if field-mutable? 'mutable 'immutable) field-name)) (list (if field-mutable? 'mutable 'immutable) field-name))
(f (+ i 1)))])))] (f (+ i 1)))])))]
[(#\b) ;;; bignum
(let ([i (read-int p)])
(let ([bytes (if (< i 0) (- i) i)])
(let ([bv (get-bytevector-n p bytes)])
(let ([n (bytevector-uint-ref bv 0 'little bytes)])
(let ([n (if (< i 0) (- n) n)])
(when m (put-mark m n))
n)))))]
[(#\f) ;;; flonum
(let ()
(import (ikarus system $flonums))
(let ([x ($make-flonum)])
($flonum-set! x 7 (get-u8 p))
($flonum-set! x 6 (get-u8 p))
($flonum-set! x 5 (get-u8 p))
($flonum-set! x 4 (get-u8 p))
($flonum-set! x 3 (get-u8 p))
($flonum-set! x 2 (get-u8 p))
($flonum-set! x 1 (get-u8 p))
($flonum-set! x 0 (get-u8 p))
(when m (put-mark m x))
x))]
[(#\r) ;;; ratnum
(let* ([den (read)]
[num (read)])
(let ([x (/ num den)])
(when m (put-mark m x))
x))]
[else [else
(die who "Unexpected char as a fasl object header" h)]))) (die who "Unexpected char as a fasl object header" h)])))
(read)) (read))

View File

@ -1 +1 @@
1410 1411

View File

@ -35,6 +35,7 @@
(tests io) (tests io)
(tests case-folding) (tests case-folding)
(tests sorting) (tests sorting)
(tests fasl)
) )
(define (test-exact-integer-sqrt) (define (test-exact-integer-sqrt)
@ -77,4 +78,5 @@
(test-bitwise-bit-count) (test-bitwise-bit-count)
(test-io) (test-io)
(test-sorting) (test-sorting)
(test-fasl)
(printf "Happy Happy Joy Joy\n") (printf "Happy Happy Joy Joy\n")

32
scheme/tests/fasl.ss Normal file
View File

@ -0,0 +1,32 @@
(library (tests fasl)
(export test-fasl)
(import (ikarus) (tests framework))
(define (test x)
(printf "test-fasl ~s\n" x)
(let-values ([(p e) (open-bytevector-output-port)])
(fasl-write x p)
(let ([bv (e)])
(let ([y (fasl-read (open-bytevector-input-port bv))])
(unless (equal? x y)
(error 'test-fasl "failed/expected" y x))))))
(define (test-fasl)
(test 12)
(test -12)
(test 0)
(test #t)
(test #f)
(test '())
(test 'hello)
(test "Hello")
(test '(Hello There))
(test 3498798327498723894789237489324)
(test -3498798327498723894789237489324)
(test 2389478923749872389723894/23498739874892379482374)
(test -2389478923749872389723894/23498739874892379482374)))