unit-tests/test-graph-container.lisp

   1 (in-package #:cl-graph-test)
   2
   3 ;;; ---------------------------------------------------------------------------
   4 ;;; utilities
   5 ;;; ---------------------------------------------------------------------------
   6
   7 (defun make-simple-test-graph ()
   8   (let ((g (make-container 'graph-container)))
   9     (loop for v in '(a b c d e) do
  10           (add-vertex g v))
  11     (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
  12           (add-edge-between-vertexes g v1 v2))
  13     g))
  14
  15 ;;; ---------------------------------------------------------------------------
  16 ;;; tests
  17 ;;; ---------------------------------------------------------------------------
  18
  19 (deftestsuite graph-container-test (cl-graph-test) ())
  20
  21 ;;; ---------------------------------------------------------------------------
  22
  23 (addtest (graph-container-test)
  24   test-empty!
  25   (let ((g1 (make-simple-test-graph)))
  26     (empty! g1)
  27     (ensure-same (size g1) 0)))
  28
  29 ;;; ---------------------------------------------------------------------------
  30 ;;; vertex test
  31 ;;; ---------------------------------------------------------------------------
  32
  33 ;;?? should be in test-graph and work for every graph container type
  34
  35 (addtest (graph-container-test)
  36   no-vertex-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 '=)))
  41
  42 (addtest (graph-container-test)
  43   vertex-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 '=)))
  48
  49
  50 ;;; ---------------------------------------------------------------------------
  51 ;;; copying
  52 ;;; ---------------------------------------------------------------------------
  53
  54 (addtest (graph-container-test)
  55   test-simple-copying
  56   (let ((g1 (make-simple-test-graph))
  57         (g2 nil))
  58     (setf g2 (copy-thing g1))
  59     (ensure-same (size g1) (size g2))
  60     (iterate-vertexes
  61      g1 (lambda (v)
  62           (ensure (find-vertex g2 (element v)))))
  63     (iterate-edges
  64      g1 (lambda (e)
  65           (ensure (find-edge-between-vertexes
  66                    g2 (element (source-vertex e))
  67                    (element (target-vertex e))))))))
  68
  69 ;;; ---------------------------------------------------------------------------
  70
  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))
  76         (g2 nil))
  77     (setf g2 (copy-thing g1))
  78
  79     (ensure (not
  80              (find-edge-between-vertexes g2 (find-vertex g1 'a) (find-vertex g1 'b))))))
  81
  82 ;;; ---------------------------------------------------------------------------
  83
  84