91 lines
2.5 KiB
Scheme
91 lines
2.5 KiB
Scheme
|
|
(library (tests fasl)
|
|
(export run-tests)
|
|
(import (ikarus) (tests framework))
|
|
|
|
|
|
(define (equal-objects? x y)
|
|
(define (vector-andmap f v . v*)
|
|
(apply andmap f (vector->list v) (map vector->list v*)))
|
|
(if (and (hashtable? x) (hashtable? y))
|
|
(and (eqv? (hashtable-hash-function x)
|
|
(hashtable-hash-function y))
|
|
(eqv? (hashtable-equivalence-function x)
|
|
(hashtable-equivalence-function y))
|
|
(let-values ([(keys vals) (hashtable-entries x)])
|
|
(vector-andmap
|
|
(lambda (k v)
|
|
(equal-objects? v (hashtable-ref y k (gensym))))
|
|
keys vals))
|
|
(let-values ([(keys vals) (hashtable-entries y)])
|
|
(vector-andmap
|
|
(lambda (k v)
|
|
(equal-objects? v (hashtable-ref x k (gensym))))
|
|
keys vals)))
|
|
(equal? x y)))
|
|
|
|
(define (test x)
|
|
(printf "test-fasl ~s\n" x)
|
|
(let ([y (deserialize (serialize x))])
|
|
(unless (equal-objects? x y)
|
|
(error 'test-fasl "failed/expected" y x))))
|
|
|
|
(define (serialize x)
|
|
(let-values ([(p e) (open-bytevector-output-port)])
|
|
(fasl-write x p)
|
|
(e)))
|
|
(define (deserialize x)
|
|
(fasl-read (open-bytevector-input-port x)))
|
|
|
|
(define (test-cycle)
|
|
(let ([x (cons 1 2)])
|
|
(set-car! x x)
|
|
(set-cdr! x x)
|
|
(printf "test-fasl ~s\n" x)
|
|
(let ([x (deserialize (serialize x))])
|
|
(assert (pair? x))
|
|
(assert (eq? x (car x)))
|
|
(assert (eq? x (cdr x))))))
|
|
|
|
|
|
(define (run-tests)
|
|
(test 12)
|
|
(test -12)
|
|
(test (greatest-fixnum))
|
|
(test (least-fixnum))
|
|
(test 0)
|
|
(test #t)
|
|
(test #f)
|
|
(test '())
|
|
(test "Hello")
|
|
(test "He\x3bb;\x3bb;o")
|
|
(test 'hello)
|
|
(test '(Hello There))
|
|
(test 3498798327498723894789237489324)
|
|
(test -3498798327498723894789237489324)
|
|
(test 2389478923749872389723894/23498739874892379482374)
|
|
(test -2389478923749872389723894/23498739874892379482374)
|
|
(test 127487384734.4)
|
|
(test (make-rectangular 12 13))
|
|
(test (make-rectangular 12.0 13.0))
|
|
(test (string #\a))
|
|
(test (string #\x3bb))
|
|
(test-cycle)
|
|
(test '#1=((x . #1#) (y . z)))
|
|
(test (let ([h (make-eq-hashtable)])
|
|
(hashtable-set! h 'foo 12)
|
|
(hashtable-set! h 'bar 13)
|
|
(collect)
|
|
h))
|
|
(test (let ([h (make-eq-hashtable)])
|
|
(hashtable-set! h (gensym) 12)
|
|
(hashtable-set! h (gensym) 13)
|
|
(collect)
|
|
h))
|
|
(test '(#\x3000))
|
|
)
|
|
|
|
)
|
|
|
|
|