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

)