source: project/release/4/lookup-table/trunk/tests/safe-synch.scm @ 16148

Last change on this file since 16148 was 16148, checked in by Kon Lovett, 10 years ago

Fix for synch variants

File size: 2.4 KB
Line 
1
2(use lookup-table-synch)
3
4;;;
5
6(newline) (print "*** Lookup Table Safe Synch ***")
7
8(use test srfi-1)
9;;;
10
11;;
12
13(define (dict-alist-test al tst)
14  (let ((foodat (alist-ref 'foo al))
15        (bazdat (alist-ref 'baz al))
16        (allen (length al)))
17
18    (let ((tbl1 (alist->dict/synch (list-copy al) tst)))
19 
20      (test-assert (dict?/synch tbl1))
21      (test tst (dict-equivalence-function/synch tbl1))
22 
23      (test-assert (tst foodat (dict-ref/synch tbl1 'foo)))
24      (test-assert (begin (dict-delete!/synch tbl1 'foo) #t))
25      (test-assert (not (dict-ref/synch tbl1 'foo)))
26 
27      (test '() (dict-update!/synch tbl1 'foo (lambda () '())))
28      (test '(1) (dict-update!/synch tbl1 'foo void (lambda (x) (append x '(1)))))
29 
30      (test '() (dict-update-list!/synch tbl1 'list))
31      (test '(1 2) (dict-update-list!/synch tbl1 'list 1 2))
32 
33      (let ((tbl2 (dict-update-dict!/synch tbl1 'dict)))
34        (test tbl2 (dict-ref/synch tbl1 'dict))
35        (test tbl2 (dict-update-dict!/synch tbl1 'dict)) ) )
36 
37    (let ((tbl (alist->dict/synch (list-copy al) tst)))
38      (test-assert (begin (dict-merge!/synch tbl (alist->dict/synch '((off . rab) (baz . pob)) tst)) #t))
39      (test (+ allen 1) (dict-count/synch tbl))
40      (test foodat (dict-ref/synch tbl 'foo))
41      (test 'pob (dict-ref/synch tbl 'baz))
42      (test 'rab (dict-ref/synch tbl 'off)) ) )
43)
44
45;;
46
47(define (dict-ht-test)
48        ; make sure not a hash-table rep initially
49  (let ((tbl1 (make-dict/synch equal? 0)))
50
51    (do ([i 0 (add1 i)])
52        ([> i 54])
53      (if (odd? i)
54          (dict-set!/synch tbl1 i (->string i))
55          (dict-set!/synch tbl1 (->string i) i)))
56
57    (test 20 (dict-ref/synch tbl1 "20"))
58    (test-assert (begin (dict-delete!/synch tbl1 "20") #t))
59    (test-assert (not (dict-ref/synch tbl1 "20")))
60
61    (test-assert (begin (dict-merge!/synch tbl1 (alist->dict/synch '((foo . bar) (baz . bop)) equal?)) #t))
62
63    (test 'bop (dict-ref/synch tbl1 'baz))
64
65    (test 'bar (dict-search/synch tbl1 (lambda (key val) (eq? key 'foo))))
66
67    (test-assert (with-output-to-string (lambda () (dict-print/synch tbl1)))) )
68)
69
70;;;
71
72(newline) (print "** Alist Test (eq?) **") (newline)
73(dict-alist-test '((foo . bar) (baz . bop)) eq?)
74(newline) (print "** Alist Test (equal?) **") (newline)
75(dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?)
76(newline) (print "** HT Test () **") (newline)
77(dict-ht-test)
Note: See TracBrowser for help on using the repository browser.