(module test-weak-map mzscheme
  (require "weak-map.ss"
           (lib "list.ss")
           (planet "test.ss" ("schematics" "schemeunit.plt" 2 4))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 4)))
  
  (define weak-map-tests
    (test-suite
     "tests for weak-map.ss"
     
     (test-case
      "empty"
      (let ([m (make-weak-map)])
        (check-pred empty? (weak-map-map m list))))
     
     (test-case
      "simple case"
      (let ([x '(1 2)]
            [m (make-weak-map)])
        (weak-map-put! m x x)
        (collect-garbage)
        (check equal? (weak-map-get m x #f) x)
        (set! x 'blah)
        (collect-garbage)
        (check equal? (weak-map-get m x #f) #f)))
     
     
     (test-case
      "equal flag"
      (let ([s (string-append "hel" "lo")]
            [m (make-weak-map 'equal)])
        (weak-map-put! m s s)
        (collect-garbage)
        (check-true (eq? (weak-map-get m (string-append "h" "ello"))
                         (weak-map-get m (string-append "he" "llo"))))
        (check equal?
               (weak-map-get m (string-append "h" "ello"))
               "hello")
        (check-false (equal? (weak-map-map m list) '()))
        (set! s #f)
        (collect-garbage)
        (check-true (equal? (weak-map-map m list) '()))))
     
     
     (test-case
      "simple case 2"
      (let ([x '(1 2)]
            [m (make-weak-map)])
        (weak-map-put! m x x)
        (collect-garbage)
        (check equal? (weak-map-get m x #f) x)
        (collect-garbage)
        (check equal? (weak-map-get m x #f) x)))
     
     (test-case
      "weak-map-map"
      (let ([m (make-weak-map)]
            [k1 (list 1)]
            [k2 (list 2)]
            [k3 (list 3)])
        (weak-map-put! m k1 k1)
        (weak-map-put! m k2 k2)
        (weak-map-put! m k3 k3)
        (set! k2 #f)
        (collect-garbage)
        (check-true
         (and (member '(1) (weak-map-map m (lambda (k v) v))) #t))
        (check-true
         (and (member '(3) (weak-map-map m (lambda (k v) v))) #t))
        (check-false
         (and (member '(2) (weak-map-map m (lambda (k v) v))) #t))))))
  
  (test/text-ui weak-map-tests))