source: project/release/5/cis/trunk/tests/run.scm @ 37361

Last change on this file since 37361 was 37361, checked in by Ivan Raikov, 3 years ago

cis: bug fixes in difference [thanks to Andre Sa]

File size: 2.4 KB
Line 
1
2;;
3;; Verifying the cis package
4;;
5
6(import scheme (chicken base) (chicken format) test cis)
7
8(define min-key 1) 
9(define max-key 10000)
10
11(define (++ x) (+ 1 x))
12(define (-- x) (- x 1))
13
14;; a hard-wired association between a key and a value
15(define compute-assoc (lambda (key) (cons key (++ key))))
16
17(test-group (sprintf  "loading a sequence [~A ... ~A] in ascending order" 
18                      min-key max-key)
19            (let recur  ((i min-key) (t empty))
20              (let ((t1 (add i t)))
21                (test (sprintf "in?  ~A t1" i) #t (in?  i t1))
22                (if (< i max-key) (recur (++ i) t1))))
23            )
24
25(test-group "set operations 1"
26            (let ((t (add 4 (add 1 (add 5 empty)))))
27              (test "adding elements out of order" '(5 4 1) (elements t)))
28
29            (let ((t1 (interval min-key (/ max-key 2)))
30                  (t2 (interval (/ max-key 2) max-key)))
31
32              (test #t (in?  min-key t1))
33              (test #t (in?  (/ max-key 2) t1))
34              (test #f (in?  max-key t1))
35              (test #f (in?  (+ 1 (/ max-key 2)) t1))
36
37              (test #f (in?  min-key t2))
38              (test #t (in?  (/ max-key 2) t2))
39              (test #t (in?  max-key t2))
40              (test #t (in?  (+ 1 (/ max-key 2)) t2))
41             
42              (test #t (in?  min-key (union t1 t2)))
43              (test #t (in?  (/ max-key 2) (union t1 t2)))
44              (test #t (in?  max-key (union t1 t2)))
45              (test #t (in?  (+ 1 (/ max-key 2)) (union t1 t2)))
46
47              (test #f (in?  min-key (intersection t1 t2)))
48              (test #t (in?  (/ max-key 2) (union t1 t2)))
49              (test #f (in?  max-key (intersection t1 t2)))
50              (test #f (in?  (+ 1 (/ max-key 2)) (intersection t1 t2)))
51
52              (test #f (in?  min-key (difference (union t1 t2) t1)))
53              (test #f (in?  (/ max-key 2) (difference (union t1 t2) t1)))
54              (test #t (in?  max-key (difference (union t1 t2) t1)))
55              (test #t (in?  (+ 1 (/ max-key 2)) (difference (union t1 t2) t1)))
56             
57              (test #t (subset? t2 (union t1 t2)))
58              (test #t (subset? t1 (union t1 t2)))
59             
60              ))
61
62(test-group "difference operations"
63
64            (test "difference of an interval and a singleton"
65                  '(1) (elements (difference (interval 1 2) (singleton 2))))
66            (test "difference of non-overlapping ranges"
67                  '(2) (elements (difference (interval 2 4) (interval 3 5))))
68            (test "difference of non-overlapping ranges"
69                  '(5) (elements (difference (interval 3 5) (interval 2 4))))
70            )
71
72(test-exit)
Note: See TracBrowser for help on using the repository browser.