#lang mzscheme

(require (only mzlib/list sort))

(require (file "hash-table.ss")
         (file "test-base.ss"))

(provide hash-table-tests)

(define test-table
  (make-hash-table/pairs
   '(a . 1)
   '(b . 2)
   '(c . 3)))

(define test-table-2
  (make-hash-table/pairs
   '(a . (1 2 3))
   '(b . (4 5 6))
   '(c . (7 8 9))))

(define test-table-3
  (make-hash-table/pairs
   '(a . ())
   '(b . ())
   '(c . ())))

(define hash-table-tests
  (test-suite "hash-table.ss"
    
    (test-case "make-hash-table/pairs works as expected"
      (check equal? (hash-table-get test-table 'a) 1)
      (check equal? (hash-table-get test-table 'b) 2)
      (check equal? (hash-table-get test-table 'c) 3)
      (check equal? (hash-table-get test-table-2 'a) '(1 2 3))
      (check equal? (hash-table-get test-table-2 'b) '(4 5 6))
      (check equal? (hash-table-get test-table-2 'c) '(7 8 9))
      (check equal? (hash-table-get test-table-3 'a) null)
      (check equal? (hash-table-get test-table-3 'b) null)
      (check equal? (hash-table-get test-table-3 'c) null))
    
    (test-case "hash-table-keys and hash-table-values"
      (let ([table (make-hash-table/pairs
                    (cons 1 "a")
                    (cons 2 "b")
                    (cons 3 "c"))])
        (check-equal? (sort (hash-table-keys table) <) (list 1 2 3) "check keys")
        (check-equal? (sort (hash-table-values table) string<?) (list "a" "b" "c") "check values")))
    
    (test-case "hash-table-mapped? works"
      (let ([table (make-hash-table/pairs
                    (cons 'a 1)
                    (cons 'b #f))])
        (check equal? (hash-table-mapped? table 'a) #t)
        (check equal? (hash-table-mapped? table 'b) #t)
        (check equal? (hash-table-mapped? table 'c) #f)))
    
    (test-case "hash-table-accessor works"
      (let ([get-value (hash-table-accessor test-table)])
        (check equal? (get-value 'a) 1)
        (check equal? (get-value 'b) 2)
        (check equal? (get-value 'c) 3)
        (check-exn exn:fail:unlib? (lambda () (get-value 'd)))))
    
    (test-case "hash-table-accessor/default works"
      (let ([get-value (hash-table-accessor/default test-table 12345)])
        (check equal? (get-value 'a) 1)
        (check equal? (get-value 'b) 2)
        (check equal? (get-value 'c) 3)
        (check equal? (get-value 'd) 12345)))
    
    (test-case "hash-table-mutator works"
      (let* ([table (hash-table-copy test-table)]
             [get-value (hash-table-accessor table)]
             [set-value! (hash-table-mutator table)])
        (check equal? (get-value 'a) 1)
        (check equal? (get-value 'b) 2)
        (check equal? (get-value 'c) 3)
        (check-exn exn:fail:unlib? (lambda () (get-value 'd)))
        (set-value! 'a 3)
        (set-value! 'c 1)
        (set-value! 'd 0)
        (check equal? (get-value 'a) 3)
        (check equal? (get-value 'b) 2)
        (check equal? (get-value 'c) 1)
        (check equal? (get-value 'd) 0)))
    
    (test-case "hash-table-mutator/append works"
      (let* ([table (hash-table-copy test-table-2)]
             [get-value (hash-table-accessor table)]
             [add-value! (hash-table-mutator/append table)])
        (check equal? (get-value 'a) '(1 2 3))
        (check equal? (get-value 'b) '(4 5 6))
        (check equal? (get-value 'c) '(7 8 9))
        (check-exn exn:fail:unlib? (lambda () (get-value 'd)))
        (add-value! 'a 4)
        (add-value! 'c 0)
        (add-value! 'd 10)
        (check equal? (get-value 'a) '(1 2 3 4))
        (check equal? (get-value 'b) '(4 5 6))
        (check equal? (get-value 'c) '(7 8 9 0))
        (check equal? (get-value 'd) '(10))))
    
    (test-case "hash-table-find finds value correctly"
      (hash-table-find
       test-table
       (lambda (key val)
         (if (even? val)
             (* val 2))))
      4)
    
    (test-case "hash-table-find fails to find value correctly"
      (hash-table-find
       test-table
       (lambda (key val)
         (> val 3)))
      #f)
    
    (test-case "hash-table-find returns default value correctly"
      (hash-table-find
       test-table
       (lambda (key val)
         (if (even? val)
             (* val 2)))
       (lambda () '(1 2 3)))
      '(1 2 3))
    
    (test-case "any-keys-have-values? returns true appropriately"
      (check equal?
             (any-keys-have-values? test-table-2)
             #t))
    
    (test-case "any-keys-have-values? returns false appropriately"
      (check equal?
             (any-keys-have-values? test-table-3)
             #f))
    
    (test-case "any-keys-have-values? throws exception when key not mapped to list"
      (check-exn 
          exn:fail:unlib?
        (lambda ()
          (any-keys-have-values? test-table))))
    
    (test-case "key-has-values? returns true appropriately"
      (check equal?
             (key-has-values? test-table-2 'b)
             #t))
    
    (test-case "key-has-values? returns false appropriately"
      (check equal?
             (key-has-values? test-table-3 'b)
             #f))
    
    (test-case "key-has-values? throws exception when key not mapped to list"
      (check-exn 
          exn:fail:unlib?
        (lambda ()
          (key-has-values? test-table 'b))))
    
    ))