;;;; Test code for HASH-FILE

;;; Start with an XCL exec.  Copy each non-commented statement
;;; from this file into the executive and observe that it behaves
;;; as described in the comments.

;;; These tests are meant to be done IN ORDER, and ONLY ONCE
;;; as many tests depend upon the sucess of previous tests.

;;; Set up a package for testing in.
;;; MAKE-PACKAGE will report an error if a package named "TEST" exists.
;;; If this happens, use a name besides "TEST".
(make-package "TEST")
(in-package "TEST")
(use-package "HASH-FILE")

;;; Test MAKE-HASH-FILE & HASH-FILE-P
(setq hash-file (make-hash-file "{dsk}test.hash" 10))
(hash-file-p hash-file)
;; should return T


;;; Test GET-HASH-FILE
(multiple-value-list (get-hash-file :foo hash-file))
;; should return (nil nil)
(multiple-value-list (get-hash-file :foo hash-file :bar))
;; should return (:bar nil)
(setf (get-hash-file :test-key hash-file) :test-value)
;; should return :test-value
(multiple-value-list (get-hash-file :test-key hash-file))
;; should return (:test-value t)

;;; Test CLOSE-HASH-FILE
(close-hash-file hash-file)
;; should return #.(pathname "{dsk}test.hash")
(multiple-value-list (get-hash-file :test-key hash-file))
;; should open hash file and return (:test-value t)
(close-hash-file hash-file)
;; should return #.(pathname "{dsk}test.hash")

;;; Test OPEN-HASH-FILE
(setq hash-file (open-hash-file "{dsk}test.hash"))
(hash-file-p hash-file)
;; should be true
(setf (get-hash-file :test-key hash-file) :test-value)
;; should signal an error
(close-hash-file hash-file)
;; should return #.(pathname "{dsk}test.hash")
(setq hash-file (open-hash-file "{dsk}test.hash" :direction :io))
(hash-file-p hash-file)
;; should be true
(setf (get-hash-file :test-key hash-file) :test-value)
;; should return :test-value

;;; Test MAP-HASH-FILE
(dotimes (n 5)
  (setf (get-hash-file n hash-file) n))
;; Note: 5 chosen as we're not yet testing rehash 
(map-hash-file
  #'(lambda (key value)
     (format t "key: ~S; value: ~S;~%" key value))
  hash-file)
;; should print contents of HASH-FILE & return NIL.
;; contents are not printed in any particular order.


;;; Test REM-HASH-FILE
(rem-hash-file :test-key hash-file)
;; should return T
(multiple-value-list (get-hash-file :test-key hash-file))
;; should return (nil nil)
(rem-hash-file :test-key hash-file)
;; should return NIL


;;; Test COPY-HASH-FILE
(setq hash-file-copy
  (copy-hash-file hash-file "{dsk}test-copy.hash"))
(hash-file-p hash-file-copy)
;; should be true
(map-hash-file
  #'(lambda (key value)
     (unless (equal (get-hash-file key hash-file) value)
       (error "COPY-HASH-FILE failed to copy key ~S correctly"
            key)))
  hash-file-copy)
;; should return NIL with no errors signalled
(map-hash-file
  #'(lambda (key value)
     (unless (equal (get-hash-file key hash-file-copy) value)
       (error "COPY-HASH-FILE failed to copy key ~S correctly"
            key)))
  hash-file)
;; should return NIL with no errors signalled


;;; Test HASH-FILE-COUNT
(= (hash-file-count hash-file) 5)
;; should be true
(setf (get-hash-file :test-key hash-file) :test-value)
(= (hash-file-count hash-file) 6)
;; should be true


;;; Test HASH-FILE-P
(and (hash-file-p hash-file) (typep hash-file 'hash-file))
;; should be true

;;; can't easily test file format

;;; Test rehashing
(dotimes (n 20)
  (setf (get-hash-file n hash-file) n))
;; should return NIL.
hash-file
;; should show that version 2 of file has been generated


;;; Test :VALUE-PRINT-FN w/ example from documentation
(defun print-circular-object (object stream)
   (let ((*print-circle* t))
      (hash-file::default-print-fn object stream)))
(setq hash-file-with-circular-values 
   (make-hash-file "{core}foo" 10
                   :value-print-fn #'print-circular-object))
(progn 
 (setq l (list "foo"))
 (setf (cdr l) l)
 (setf (get-hash-file "bar" hash-file-with-circular-values) l)
 (setq l2 (get-hash-file "bar" hash-file-with-circular-values))
 nil)

(eq l l2)
;; should return nil
(let ((*print-circle* t))
 (string= (prin1-to-string l) (prin1-to-string l2)))
;; should return t

;;; Test default hashing methods
;;; We've already seen integers, symbols & strings work as keys
;; lists
(setf (get-hash-file '(a . b) hash-file) '(c d e))
(equal (get-hash-file '(a . b) hash-file) '(c d e))
;; floats
(setf (get-hash-file pi hash-file) (log pi))
(= (get-hash-file pi hash-file) (log pi))
;; ratios
(setf (get-hash-file 1/3 hash-file) 1/7)
(= (get-hash-file 1/3 hash-file) 1/7)
;; complex 
(setf (get-hash-file #c(1 2) hash-file) #c(3 4))
(= (get-hash-file #c(1 2) hash-file) #c(3 4))
;; characters
(setf (get-hash-file #\space hash-file) #\newline)
(eql (get-hash-file #\space hash-file) #\newline)
;; pathnames
(setf (get-hash-file (pathname "foo") hash-file) (pathname "bar"))
(equal (get-hash-file (pathname "foo") hash-file) (pathname "bar"))

;; clean up
(close-hash-file hash-file-with-circular-values)
(delete-file "{core}foo")

(close-hash-file hash-file)
(il:while (xcl:ignore-errors (delete-file "{dsk}test.hash"))  ; delete all versions
)

(close-hash-file hash-file-copy)
(delete-file "{dsk}test-copy.hash")