1 (in-package #:cl-graph-test)
3 (defun build-single-diamond-graph (style)
7 (let ((g (make-container 'graph-container)))
8 (loop for (source . target) in '((a . b)
9 (b . c) (b . i) (c . d) (i . d)
11 (add-edge-between-vertexes g source target :edge-type style))
14 (defun build-three-way-graph ()
15 (let ((g (make-container 'graph-container)))
16 (loop for (source . target) in '((a . b)
17 (b . c) (b . d) (b . e)
18 (c . f) (d . f) (e . f)
20 (add-edge-between-vertexes g source target))
23 (deftestsuite test-api (cl-graph-test)
27 :documentation "case 214")
29 (let* ((g (build-single-diamond-graph :directed))
30 (b (find-vertex g 'b))
31 (target-edges (target-edges b))
32 (source-edges (source-edges b)))
33 (ensure (every (lambda (edge)
34 (eq b (source-vertex edge)))
35 source-edges) :report "sources")
36 (ensure (every (lambda (edge)
37 (eq b (target-vertex edge)))
38 target-edges) :report "targets")))
41 :documentation "case 218")
42 parents-of-child-vertexes
43 (let* ((g (build-single-diamond-graph :directed))
44 (b (find-vertex g 'b))
45 (child-vertexes (child-vertexes b)))
46 (ensure (every (lambda (vertex)
47 (member b (parent-vertexes vertex)))
48 child-vertexes) :report "children")))
51 :documentation "case 218")
52 children-of-parent-vertexes
53 (let* ((g (build-single-diamond-graph :directed))
54 (b (find-vertex g 'b))
55 (parent-vertexes (parent-vertexes b)))
56 (ensure (every (lambda (vertex)
57 (member b (child-vertexes vertex)))
58 parent-vertexes) :report "parents")))
61 :documentation "case 218")
62 parents-and-children=are-correct
63 (let* ((g (build-single-diamond-graph :directed))
64 (b (find-vertex g 'b))
65 (child-vertexes (child-vertexes b))
66 (parent-vertexes (parent-vertexes b)))
67 (ensure-same child-vertexes (list (find-vertex g 'c)
70 (ensure-same parent-vertexes (list (find-vertex g 'a))