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

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

Removed some alphanumeric versions that seem to confuse make-egg-index.

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;;
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 node-list
47  (delete-duplicates
48   (concatenate (list (map car used-by) (map cdr used-by)))))
49
50(define node-ids
51  (list-tabulate (length node-list) values))
52
53(define node-map  (zip node-list node-ids)) 
54
55(test-group "digraph test"
56  (let ((g (make-digraph 'depgraph "dependency graph")))
57
58  ;; add the nodes to the graph
59    (for-each (lambda (i n) ((g 'add-node!) i n))
60              node-ids node-list)
61
62  ;; make sure all nodes got inserted
63  (test "add nodes to the graph"
64   ((g 'nodes))
65   '((14 killerapp)
66     (13 libzigzag_a) (12 zag_o) (11 zag_cpp)
67     (10 zig_o) (9 zig_cpp) (8 libfoobar_a) (7 bar_o)
68     (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (2 boz_h)
69     (1 yow_h) (0 dax_h)))
70
71  ;; add the edges to the graph
72  (for-each (lambda (e)
73              (let* ((ni (car e))
74                     (nj (cdr e))
75                     (i (car (alist-ref ni node-map)))
76                     (j (car (alist-ref nj node-map))))
77                ((g 'add-edge!) (list i j (format "~A->~A" ni nj)))))
78            used-by)
79
80   ;; make sure all edges got correctly created
81   (test "add edges to the graph"
82    ((g 'edges))
83    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
84      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
85      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
86      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
87      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
88      (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
89      (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
90      (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")
91      (0 1 "dax_h->yow_h") (0 6 "dax_h->bar_cpp") (0 4 "dax_h->foo_cpp")))
92
93    ;; remove node 0 from graph
94   ((g 'remove-node!) 0)
95
96   ;; make sure node 0 got removed
97   (test "remove node 0"
98    ((g 'nodes))
99    '((14 killerapp) (13 libzigzag_a) (12 zag_o)
100      (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
101      (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h)
102      (2 boz_h) (1 yow_h)))
103
104    ;; make sure the edges of node 0 got removed
105   (test "make sure node 0 edges got removed"
106    ((g 'edges))
107    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
108      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
109      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
110      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
111      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
112      (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
113      (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
114      (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")))
115
116    ;; remove node 2 from graph
117   ((g 'remove-node!) 2)
118
119   ;; make sure node 2 got removed
120   (test "remove node 2"
121    ((g 'nodes))
122    '((14 killerapp) (13 libzigzag_a) (12 zag_o)
123      (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
124      (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (1 yow_h)))
125
126   ;; make sure the edges of node 2 got removed
127   (test "make sure node 2 edges got removed"
128    ((g 'edges))
129    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
130      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
131      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
132      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
133      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
134      (3 4 "zow_h->foo_cpp") (1 11 "yow_h->zag_cpp")
135      (1 6 "yow_h->bar_cpp")))
136  ))
137 
Note: See TracBrowser for help on using the repository browser.