(use lookup-table-synch) ;;; (newline) (print "*** Lookup Table Safe Synch ***") (use test srfi-1) ;;; ;; (define (dict-alist-test al tst) (let ((foodat (alist-ref 'foo al)) (bazdat (alist-ref 'baz al)) (allen (length al))) (let ((tbl1 (alist->dict/synch (list-copy al) tst))) (test-assert (dict?/synch tbl1)) (test tst (dict-equivalence-function/synch tbl1)) (test-assert (tst foodat (dict-ref/synch tbl1 'foo))) (test-assert (begin (dict-delete!/synch tbl1 'foo) #t)) (test-assert (not (dict-ref/synch tbl1 'foo))) (test '() (dict-update!/synch tbl1 'foo (lambda () '()))) (test '(1) (dict-update!/synch tbl1 'foo void (lambda (x) (append x '(1))))) (test '() (dict-update-list!/synch tbl1 'list)) (test '(1 2) (dict-update-list!/synch tbl1 'list 1 2)) (let ((tbl2 (dict-update-dict!/synch tbl1 'dict))) (test tbl2 (dict-ref/synch tbl1 'dict)) (test tbl2 (dict-update-dict!/synch tbl1 'dict)) ) ) (let ((tbl (alist->dict/synch (list-copy al) tst))) (test-assert (begin (dict-merge!/synch tbl (alist->dict/synch '((off . rab) (baz . pob)) tst)) #t)) (test (+ allen 1) (dict-count/synch tbl)) (test foodat (dict-ref/synch tbl 'foo)) (test 'pob (dict-ref/synch tbl 'baz)) (test 'rab (dict-ref/synch tbl 'off)) ) ) ) ;; (define (dict-ht-test) ; make sure not a hash-table rep initially (let ((tbl1 (make-dict/synch equal? 0))) (do ([i 0 (add1 i)]) ([> i 54]) (if (odd? i) (dict-set!/synch tbl1 i (->string i)) (dict-set!/synch tbl1 (->string i) i))) (test 20 (dict-ref/synch tbl1 "20")) (test-assert (begin (dict-delete!/synch tbl1 "20") #t)) (test-assert (not (dict-ref/synch tbl1 "20"))) (test-assert (begin (dict-merge!/synch tbl1 (alist->dict/synch '((foo . bar) (baz . bop)) equal?)) #t)) (test 'bop (dict-ref/synch tbl1 'baz)) (test 'bar (dict-search/synch tbl1 (lambda (key val) (eq? key 'foo)))) (test-assert (with-output-to-string (lambda () (dict-print/synch tbl1)))) ) ) ;;; (newline) (print "** Alist Test (eq?) **") (newline) (dict-alist-test '((foo . bar) (baz . bop)) eq?) (newline) (print "** Alist Test (equal?) **") (newline) (dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?) (newline) (print "** HT Test () **") (newline) (dict-ht-test)