unit-tests/test-api.lisp

   1 (in-package #:cl-graph-test)
   2
   3 (defun build-single-diamond-graph (style)
   4 ;;;;      /- c -\
   5 ;;;; a - b       d - e
   6 ;;;;      \- i -/
   7   (let ((g (make-container 'graph-container)))
   8     (loop for (source . target) in '((a . b)
   9                                      (b . c) (b . i) (c . d) (i . d)
  10                                      (d . e)) do
  11          (add-edge-between-vertexes g source target :edge-type style))
  12     g))
  13
  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)
  19                                       (f . g)) do
  20           (add-edge-between-vertexes g source target))
  21      g))
  22
  23 (deftestsuite test-api (cl-graph-test)
  24   (g))
  25
  26 (addtest (test-api
  27           :documentation "case 214")
  28   source-edges
  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")))
  39
  40 (addtest (test-api
  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")))
  49
  50 (addtest (test-api
  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")))
  59
  60 (addtest (test-api
  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)
  68                                       (find-vertex g 'i))
  69                  :test 'set-equal))
  70     (ensure-same parent-vertexes (list (find-vertex g 'a))
  71                  :test 'set-equal))