source: project/release/4/interval-digraph/tests/run.scm @ 20659

Last change on this file since 20659 was 20659, checked in by Ivan Raikov, 10 years ago

initial import of interval-digraph, a directed graph implementation based on adjacency intervals

File size: 4.8 KB
Line 
1;;
2;;
3;; Verifying the digraph package. Code adapted from the Boost graph
4;; library dependency example.
5;;
6;; Copyright 2007-2010 Ivan Raikov and the Okinawa Institute of Science and Technology
7;;
8;; This program is free software: you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or (at
11;; your option) any later version.
12;;
13;; This program is distributed in the hope that it will be useful, but
14;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16;; General Public License for more details.
17;;
18;; A full copy of the GPL license can be found at
19;; <http://www.gnu.org/licenses/>.
20;;
21;;
22;;
23
24(require-library srfi-1 test interval-digraph)
25(import srfi-1 test
26        (prefix interval-digraph   interval-digraph:))
27
28
29(define used-by
30  (list
31    (cons 'dax_h 'foo_cpp) (cons 'dax_h 'bar_cpp) (cons 'dax_h 'yow_h)
32    (cons 'yow_h 'bar_cpp) (cons 'yow_h 'zag_cpp) (cons 'boz_h 'bar_cpp)
33    (cons 'boz_h 'zig_cpp) (cons 'boz_h 'zag_cpp) (cons 'zow_h 'foo_cpp)
34    (cons 'foo_cpp 'foo_o) (cons 'foo_o 'libfoobar_a)
35    (cons 'bar_cpp 'bar_o) (cons 'bar_o 'libfoobar_a)
36    (cons 'libfoobar_a 'libzigzag_a) (cons 'zig_cpp 'zig_o)
37    (cons 'zig_o 'libzigzag_a) (cons 'zag_cpp 'zag_o)
38    (cons 'zag_o 'libzigzag_a) (cons 'libzigzag_a 'killerapp)))
39
40
41(define node-list
42  (delete-duplicates
43   (concatenate (list (map car used-by) (map cdr used-by)))))
44
45
46(define node-ids
47  (list-tabulate (length node-list) values))
48
49(define node-map  (zip node-list node-ids)) 
50
51(test-group "interval digraph test"
52  (let* ((g (interval-digraph:make-digraph  'depgraph  "dependency graph"))
53         
54         ;; add the nodes to the graph
55         (g (fold (lambda (i n g) ((g 'add-node) i label: n))
56                  g node-ids node-list)))
57
58    ;; make sure all nodes got inserted
59    (test "add nodes to the graph"
60          (map first
61               '((14 killerapp)
62                 (13 libzigzag_a) (12 zag_o) (11 zag_cpp)
63                 (10 zig_o) (9 zig_cpp) (8 libfoobar_a) (7 bar_o)
64                 (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (2 boz_h)
65                 (1 yow_h) (0 dax_h)))
66          ((g 'nodes)))
67
68    (let ((g1  ;; add the edges to the graph
69           (fold (lambda (e g)
70                   (let* ((ni (car e))
71                          (nj (cdr e))
72                          (i (car (alist-ref ni node-map)))
73                          (j (car (alist-ref nj node-map))))
74                     ((g 'add-edge) (list i j) label: (format "~A->~A" ni nj))))
75                 g used-by)))
76
77      ;; make sure all edges got correctly created
78      (test "add edges to the graph"
79            '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
80              (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
81              (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
82              (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
83              (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
84              (3 4 "zow_h->foo_cpp") (2 6 "boz_h->bar_cpp")
85              (2 9 "boz_h->zig_cpp") (2 11 "boz_h->zag_cpp")
86              (1 6 "yow_h->bar_cpp") (1 11 "yow_h->zag_cpp") 
87              (0 1 "dax_h->yow_h") (0 4 "dax_h->foo_cpp") 
88              (0 6 "dax_h->bar_cpp") )
89            ((g1 'edges-with-labels)))
90
91      (let ((g2 ;; remove node 0 from graph
92             ((g1 'remove-node) 0)))
93       
94        ;; make sure node 0 got removed
95        (test "remove node 0"
96              '((14 killerapp) (13 libzigzag_a) (12 zag_o)
97                (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
98                (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h)
99                (2 boz_h) (1 yow_h))
100              ((g2 'nodes-with-labels)))
101       
102        ;; remove node 2 from graph
103        (let ((g2 ((g2 'remove-node) 2)))
104         
105         
106          ;; make sure node 2 got removed
107          (test "remove node 2"
108                '((14 killerapp) (13 libzigzag_a) (12 zag_o)
109                  (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
110                  (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (1 yow_h))
111                ((g2 'nodes-with-labels)))
112         
113          ;; make sure the edges of node 2 got removed
114          (test "make sure node 2 edges got removed"
115                (map (lambda (x) (take x 2))
116                     '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
117                       (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
118                       (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
119                       (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
120                       (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
121                       (3 4 "zow_h->foo_cpp") (1 6 "yow_h->bar_cpp")
122                       (1 11 "yow_h->zag_cpp")
123                       ))
124                ((g2 'edges)))
125
126          (test "make sure node 2 edges got removed (with labels)"
127                     '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
128                       (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
129                       (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
130                       (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
131                       (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
132                       (3 4 "zow_h->foo_cpp") (1 6 "yow_h->bar_cpp")
133                       (1 11 "yow_h->zag_cpp")
134                       )
135                ((g2 'edges-with-labels)))
136         
137          ))
138
139     
140      )
141
142    ))
Note: See TracBrowser for help on using the repository browser.