1 (in-package #:cl-graph-test)
3 ;;; ---------------------------------------------------------------------------
5 ;;; ---------------------------------------------------------------------------
7 (defun make-simple-test-graph ()
8 (let ((g (make-container 'graph-container)))
9 (loop for v in '(a b c d e) do
11 (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
12 (add-edge-between-vertexes g v1 v2))
15 ;;; ---------------------------------------------------------------------------
17 ;;; ---------------------------------------------------------------------------
19 (deftestsuite graph-container-test (cl-graph-test) ())
21 ;;; ---------------------------------------------------------------------------
23 (addtest (graph-container-test)
25 (let ((g1 (make-simple-test-graph)))
27 (ensure-same (size g1) 0)))
29 ;;; ---------------------------------------------------------------------------
31 ;;; ---------------------------------------------------------------------------
33 ;;?? should be in test-graph and work for every graph container type
35 (addtest (graph-container-test)
37 (let ((g (make-container 'graph-container)))
38 (loop for (src dst) in '((a b) (a c) (c d) (a d) (d e) (e f) (b f)) do
39 (add-edge-between-vertexes g (list src) (list dst)))
40 (ensure-same (size g) 14 :test '=)))
42 (addtest (graph-container-test)
44 (let ((g (make-container 'graph-container :vertex-test #'equal)))
45 (loop for (src dst) in '((a b) (a c) (c d) (a d) (d e) (e f) (b f)) do
46 (add-edge-between-vertexes g (list src) (list dst)))
47 (ensure-same (size g) 6 :test '=)))
50 ;;; ---------------------------------------------------------------------------
52 ;;; ---------------------------------------------------------------------------
54 (addtest (graph-container-test)
56 (let ((g1 (make-simple-test-graph))
58 (setf g2 (copy-thing g1))
59 (ensure-same (size g1) (size g2))
62 (ensure (find-vertex g2 (element v)))))
65 (ensure (find-edge-between-vertexes
66 g2 (element (source-vertex e))
67 (element (target-vertex e))))))))
69 ;;; ---------------------------------------------------------------------------
71 ;; fails because find-edge-between-vertexes for graph containers doesn't
72 ;; care about the graph...
73 (addtest (graph-container-test)
74 test-find-edge-between-vertexes
75 (let ((g1 (make-simple-test-graph))
77 (setf g2 (copy-thing g1))
80 (find-edge-between-vertexes g2 (find-vertex g1 'a) (find-vertex g1 'b))))))
82 ;;; ---------------------------------------------------------------------------