170 lines
5.0 KiB
Plaintext
170 lines
5.0 KiB
Plaintext
;;;; 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")
|