source: project/release/4/lookup-table/trunk/tests/unsafe-synch.scm @ 16134

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

Test for /synch variants

File size: 2.5 KB
Line 
1
2(use lookup-table-unsafe-synch)
3
4;;;
5
6(newline) (print "*** Lookup Table UnSafe 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-assert (dict?/%synch (dict-ref/%synch tbl1 'dict)))
35        (test tbl2 (dict-ref/%synch tbl1 'dict))
36        (test tbl2 (dict-update-dict!/%synch tbl1 'dict)) ) )
37 
38    (let ((tbl (alist->dict/%synch (list-copy al) tst)))
39      (test-assert (begin (dict-merge!/%synch tbl (alist->dict/%synch '((off . rab) (baz . pob)) tst)) #t))
40      (test (+ allen 1) (dict-count/%synch tbl))
41      (test foodat (dict-ref/%synch tbl 'foo))
42      (test 'pob (dict-ref/%synch tbl 'baz))
43      (test 'rab (dict-ref/%synch tbl 'off)) ) )
44)
45
46;;
47
48(define (dict-ht-test)
49        ; make sure not a hash-table rep initially
50  (let ((tbl1 (make-dict/%synch equal? 0)))
51
52    (do ([i 0 (add1 i)])
53        ([> i 54])
54      (if (odd? i)
55          (dict-set!/%synch tbl1 i (->string i))
56          (dict-set!/%synch tbl1 (->string i) i)))
57
58    (test 20 (dict-ref/%synch tbl1 "20"))
59    (test-assert (begin (dict-delete!/%synch tbl1 "20") #t))
60    (test-assert (not (dict-ref/%synch tbl1 "20")))
61
62    (test-assert (begin (dict-merge!/%synch tbl1 (alist->dict/%synch '((foo . bar) (baz . bop)) equal?)) #t))
63
64    (test 'bop (dict-ref/%synch tbl1 'baz))
65
66    (test 'bar (dict-search/%synch tbl1 (lambda (key val) (eq? key 'foo))))
67
68    (test-assert (with-output-to-string (lambda () (dict-print/%synch tbl1)))) )
69)
70
71;;;
72
73(newline) (print "** Alist Test (eq?) **") (newline)
74(dict-alist-test '((foo . bar) (baz . bop)) eq?)
75(newline) (print "** Alist Test (equal?) **") (newline)
76(dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?)
77(newline) (print "** HT Test () **") (newline)
78(dict-ht-test)
Note: See TracBrowser for help on using the repository browser.