source: project/release/4/digraph/trunk/tests/run.scm @ 14334

Last change on this file since 14334 was 14334, checked in by Ivan Raikov, 11 years ago

Ported digraph library to Chicken 4.

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