ENH make all tests work without floating nodes
This commit is contained in:
parent
2fa40b763f
commit
346e41776b
|
@ -57,9 +57,9 @@
|
||||||
(dag-test-sets-equal-p (-map #'car broken-edges-alist)
|
(dag-test-sets-equal-p (-map #'car broken-edges-alist)
|
||||||
(dag-test-ht-keys b))))
|
(dag-test-ht-keys b))))
|
||||||
|
|
||||||
(defun dag-test-has-valid-floating-nodes-p (dag floating-nodes)
|
;; (defun dag-test-has-valid-floating-nodes-p (dag floating-nodes)
|
||||||
(-let (((&plist :floating-nodes f) dag))
|
;; (-let (((&plist :floating-nodes f) dag))
|
||||||
(dag-test-sets-equal-p floating-nodes (dag-test-ht-keys f))))
|
;; (dag-test-sets-equal-p floating-nodes (dag-test-ht-keys f))))
|
||||||
|
|
||||||
(defun dag-test-has-valid-order-p (dag order)
|
(defun dag-test-has-valid-order-p (dag order)
|
||||||
(-let (((&plist :order o) dag))
|
(-let (((&plist :order o) dag))
|
||||||
|
@ -67,81 +67,74 @@
|
||||||
|
|
||||||
;; test macros
|
;; test macros
|
||||||
|
|
||||||
(defmacro dag-test-dag-is-valid-p (dag adjlist broken-edges floating-nodes order)
|
(defmacro dag-test-dag-is-valid-p (dag adjlist broken-edges order)
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
`(progn
|
`(progn
|
||||||
(dag-test-has-valid-adjlist-p ,dag ',adjlist)
|
(dag-test-has-valid-adjlist-p ,dag ',adjlist)
|
||||||
(dag-test-has-valid-broken-edges-p ,dag ',broken-edges)
|
(dag-test-has-valid-broken-edges-p ,dag ',broken-edges)
|
||||||
(dag-test-has-valid-floating-nodes-p ,dag ',floating-nodes)
|
|
||||||
(dag-test-has-valid-order-p ,dag ',order)))
|
(dag-test-has-valid-order-p ,dag ',order)))
|
||||||
|
|
||||||
(defmacro dag-test-alist-is-valid-p (alist adjlist broken-edges floating-nodes order)
|
(defmacro dag-test-alist-is-valid-p (alist adjlist broken-edges order)
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
`(let ((dag (dag-alist-to-dag ',alist)))
|
`(let ((dag (dag-alist-to-dag ',alist)))
|
||||||
(dag-test-dag-is-valid-p dag
|
(dag-test-dag-is-valid-p dag
|
||||||
,adjlist ,broken-edges ,floating-nodes ,order)))
|
,adjlist ,broken-edges ,order)))
|
||||||
|
|
||||||
(defmacro dag-test-alist-remove-is-valid-p (alist to-remove adjlist broken-edges
|
(defmacro dag-test-alist-remove-is-valid-p (alist to-remove adjlist broken-edges
|
||||||
floating-nodes order)
|
order)
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
`(let ((dag (->> (dag-alist-to-dag ',alist)
|
`(let ((dag (->> (dag-alist-to-dag ',alist)
|
||||||
(dag-remove-nodes ',to-remove))))
|
(dag-remove-nodes ',to-remove))))
|
||||||
(dag-test-dag-is-valid-p dag
|
(dag-test-dag-is-valid-p dag
|
||||||
,adjlist ,broken-edges ,floating-nodes ,order)))
|
,adjlist ,broken-edges ,order)))
|
||||||
|
|
||||||
(defmacro dag-test-alist-insert-is-valid-p (alist to-insert adjlist broken-edges
|
(defmacro dag-test-alist-insert-is-valid-p (alist to-insert adjlist broken-edges
|
||||||
floating-nodes order)
|
order)
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
`(let ((dag (->> (dag-alist-to-dag ',alist)
|
`(let ((dag (->> (dag-alist-to-dag ',alist)
|
||||||
(dag-insert-nodes ',to-insert))))
|
(dag-insert-nodes ',to-insert))))
|
||||||
(dag-test-dag-is-valid-p dag
|
(dag-test-dag-is-valid-p dag
|
||||||
,adjlist ,broken-edges ,floating-nodes ,order)))
|
,adjlist ,broken-edges ,order)))
|
||||||
|
|
||||||
(defmacro dag-test-alist-edit-is-valid-p (alist to-remove to-insert adjlist
|
(defmacro dag-test-alist-edit-is-valid-p (alist to-remove to-insert adjlist
|
||||||
broken-edges floating-nodes
|
broken-edges order)
|
||||||
order)
|
|
||||||
(declare (indent 3))
|
(declare (indent 3))
|
||||||
`(let ((dag (->> (dag-alist-to-dag ',alist)
|
`(let ((dag (->> (dag-alist-to-dag ',alist)
|
||||||
(dag-edit-nodes ',to-remove ',to-insert))))
|
(dag-edit-nodes ',to-remove ',to-insert))))
|
||||||
(dag-test-dag-is-valid-p dag
|
(dag-test-dag-is-valid-p dag
|
||||||
,adjlist ,broken-edges ,floating-nodes ,order)))
|
,adjlist ,broken-edges ,order)))
|
||||||
|
|
||||||
;; tests
|
;; tests
|
||||||
|
|
||||||
(ert-deftest dag-test-null ()
|
(ert-deftest dag-test-null ()
|
||||||
(dag-test-alist-is-valid-p nil
|
(dag-test-alist-is-valid-p nil
|
||||||
nil
|
|
||||||
nil
|
nil
|
||||||
nil
|
nil
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(ert-deftest dag-test-one ()
|
(ert-deftest dag-test-one ()
|
||||||
(dag-test-alist-is-valid-p ((a))
|
(dag-test-alist-is-valid-p ((a))
|
||||||
|
((a :children nil :parents nil))
|
||||||
nil
|
nil
|
||||||
nil
|
(a)))
|
||||||
(a)
|
|
||||||
nil))
|
|
||||||
|
|
||||||
(ert-deftest dag-test-one-cycle ()
|
(ert-deftest dag-test-one-cycle ()
|
||||||
(dag-test-alist-is-valid-p ((a a))
|
(dag-test-alist-is-valid-p ((a a))
|
||||||
((a :children (a) :parents (a)))
|
((a :children (a) :parents (a)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(ert-deftest dag-test-one-broken ()
|
(ert-deftest dag-test-one-broken ()
|
||||||
(dag-test-alist-is-valid-p ((a b))
|
(dag-test-alist-is-valid-p ((a b))
|
||||||
nil
|
((a :children nil :parents nil))
|
||||||
((a b))
|
((a b))
|
||||||
(a)
|
(a)))
|
||||||
nil))
|
|
||||||
|
|
||||||
(ert-deftest dag-test-two ()
|
(ert-deftest dag-test-two ()
|
||||||
(dag-test-alist-is-valid-p ((a) (b a))
|
(dag-test-alist-is-valid-p ((a) (b a))
|
||||||
((a :children (b) :parents nil)
|
((a :children (b) :parents nil)
|
||||||
(b :children nil :parents (a)))
|
(b :children nil :parents (a)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a b)))
|
(a b)))
|
||||||
|
|
||||||
(ert-deftest dag-test-two-cycle ()
|
(ert-deftest dag-test-two-cycle ()
|
||||||
|
@ -149,22 +142,20 @@
|
||||||
((a :children (b) :parents (b))
|
((a :children (b) :parents (b))
|
||||||
(b :children (a) :parents (a)))
|
(b :children (a) :parents (a)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(ert-deftest dag-test-two-floating ()
|
(ert-deftest dag-test-two-floating ()
|
||||||
(dag-test-alist-is-valid-p ((a) (b))
|
(dag-test-alist-is-valid-p ((a) (b))
|
||||||
|
((a :children nil :parents nil)
|
||||||
|
(b :children nil :parents nil))
|
||||||
nil
|
nil
|
||||||
nil
|
(b a)))
|
||||||
(a b)
|
|
||||||
nil))
|
|
||||||
|
|
||||||
(ert-deftest dag-test-two-broken ()
|
(ert-deftest dag-test-two-broken ()
|
||||||
(dag-test-alist-is-valid-p ((a) (b a c))
|
(dag-test-alist-is-valid-p ((a) (b a c))
|
||||||
((a :children (b) :parents nil)
|
((a :children (b) :parents nil)
|
||||||
(b :children nil :parents (a)))
|
(b :children nil :parents (a)))
|
||||||
((b c))
|
((b c))
|
||||||
nil
|
|
||||||
(a b)))
|
(a b)))
|
||||||
|
|
||||||
(ert-deftest dag-test-three-linear ()
|
(ert-deftest dag-test-three-linear ()
|
||||||
|
@ -173,7 +164,6 @@
|
||||||
(b :children (c) :parents (a))
|
(b :children (c) :parents (a))
|
||||||
(c :children nil :parents (b)))
|
(c :children nil :parents (b)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a b c)))
|
(a b c)))
|
||||||
|
|
||||||
(ert-deftest dag-test-three-tree ()
|
(ert-deftest dag-test-three-tree ()
|
||||||
|
@ -182,7 +172,6 @@
|
||||||
(b :children nil :parents (a))
|
(b :children nil :parents (a))
|
||||||
(c :children nil :parents (a)))
|
(c :children nil :parents (a)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a c b)))
|
(a c b)))
|
||||||
|
|
||||||
(ert-deftest dag-test-complicated ()
|
(ert-deftest dag-test-complicated ()
|
||||||
|
@ -197,10 +186,11 @@
|
||||||
(b :children (d e) :parents (a))
|
(b :children (d e) :parents (a))
|
||||||
(c :children (d e) :parents (a))
|
(c :children (d e) :parents (a))
|
||||||
(d :children nil :parents (b c))
|
(d :children nil :parents (b c))
|
||||||
(e :children nil :parents (b c)))
|
(e :children nil :parents (b c))
|
||||||
|
(x :children nil :parents nil)
|
||||||
|
(z :children nil :parents nil))
|
||||||
((x y))
|
((x y))
|
||||||
(x z)
|
(z x a c b e d)))
|
||||||
(a c b e d)))
|
|
||||||
|
|
||||||
(ert-deftest dag-test-remove ()
|
(ert-deftest dag-test-remove ()
|
||||||
(dag-test-alist-remove-is-valid-p ((a)
|
(dag-test-alist-remove-is-valid-p ((a)
|
||||||
|
@ -214,7 +204,6 @@
|
||||||
(c :children (d) :parents (a))
|
(c :children (d) :parents (a))
|
||||||
(d :children nil :parents (b c)))
|
(d :children nil :parents (b c)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a c b d)))
|
(a c b d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-remove-break ()
|
(ert-deftest dag-test-remove-break ()
|
||||||
|
@ -228,7 +217,6 @@
|
||||||
(b :children (d) :parents (a))
|
(b :children (d) :parents (a))
|
||||||
(d :children nil :parents (b)))
|
(d :children nil :parents (b)))
|
||||||
((d c))
|
((d c))
|
||||||
nil
|
|
||||||
(a b d)))
|
(a b d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-remove-break-float ()
|
(ert-deftest dag-test-remove-break-float ()
|
||||||
|
@ -238,10 +226,10 @@
|
||||||
(d c))
|
(d c))
|
||||||
(b)
|
(b)
|
||||||
((c :children (d) :parents nil)
|
((c :children (d) :parents nil)
|
||||||
(d :children nil :parents (c)))
|
(d :children nil :parents (c))
|
||||||
|
(a :children nil :parents nil))
|
||||||
((c b))
|
((c b))
|
||||||
(a)
|
(c a d)))
|
||||||
(c d)))
|
|
||||||
|
|
||||||
(ert-deftest dag-test-insert ()
|
(ert-deftest dag-test-insert ()
|
||||||
(dag-test-alist-insert-is-valid-p ((a)
|
(dag-test-alist-insert-is-valid-p ((a)
|
||||||
|
@ -255,7 +243,6 @@
|
||||||
(d :children nil :parents (b c))
|
(d :children nil :parents (b c))
|
||||||
(e :children nil :parents (b c)))
|
(e :children nil :parents (b c)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a c b d e)))
|
(a c b d e)))
|
||||||
|
|
||||||
(ert-deftest dag-test-insert-overwrite ()
|
(ert-deftest dag-test-insert-overwrite ()
|
||||||
|
@ -269,7 +256,6 @@
|
||||||
(c :children (d) :parents (a))
|
(c :children (d) :parents (a))
|
||||||
(d :children nil :parents (b c)))
|
(d :children nil :parents (b c)))
|
||||||
((d x))
|
((d x))
|
||||||
nil
|
|
||||||
(a c b d)))
|
(a c b d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-insert-floating ()
|
(ert-deftest dag-test-insert-floating ()
|
||||||
|
@ -279,10 +265,10 @@
|
||||||
((d))
|
((d))
|
||||||
((a :children (b c) :parents nil)
|
((a :children (b c) :parents nil)
|
||||||
(b :children nil :parents (a))
|
(b :children nil :parents (a))
|
||||||
(c :children nil :parents (a)))
|
(c :children nil :parents (a))
|
||||||
|
(d :children nil :parents nil))
|
||||||
nil
|
nil
|
||||||
(d)
|
(a d c b)))
|
||||||
(a c b)))
|
|
||||||
|
|
||||||
(ert-deftest dag-test-insert-broken ()
|
(ert-deftest dag-test-insert-broken ()
|
||||||
(dag-test-alist-insert-is-valid-p ((a)
|
(dag-test-alist-insert-is-valid-p ((a)
|
||||||
|
@ -294,7 +280,6 @@
|
||||||
(c :children (d) :parents (a))
|
(c :children (d) :parents (a))
|
||||||
(d :children nil :parents (c)))
|
(d :children nil :parents (c)))
|
||||||
((d x))
|
((d x))
|
||||||
nil
|
|
||||||
(a c b d)))
|
(a c b d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-insert-fix-broken ()
|
(ert-deftest dag-test-insert-fix-broken ()
|
||||||
|
@ -307,7 +292,6 @@
|
||||||
(c :children (d) :parents (b))
|
(c :children (d) :parents (b))
|
||||||
(d :children nil :parents (c)))
|
(d :children nil :parents (c)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a b c d)))
|
(a b c d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-edit ()
|
(ert-deftest dag-test-edit ()
|
||||||
|
@ -325,7 +309,6 @@
|
||||||
(d :children nil :parents (c))
|
(d :children nil :parents (c))
|
||||||
(e :children nil :parents (c)))
|
(e :children nil :parents (c)))
|
||||||
((e b))
|
((e b))
|
||||||
nil
|
|
||||||
(c a e d)))
|
(c a e d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-edit-remove ()
|
(ert-deftest dag-test-edit-remove ()
|
||||||
|
@ -341,7 +324,6 @@
|
||||||
(c :children (d) :parents (a))
|
(c :children (d) :parents (a))
|
||||||
(d :children nil :parents (b c)))
|
(d :children nil :parents (b c)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a c b d)))
|
(a c b d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-edit-insert ()
|
(ert-deftest dag-test-edit-insert ()
|
||||||
|
@ -357,7 +339,6 @@
|
||||||
(d :children nil :parents (b c))
|
(d :children nil :parents (b c))
|
||||||
(e :children nil :parents (b c)))
|
(e :children nil :parents (b c)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a c b d e)))
|
(a c b d e)))
|
||||||
|
|
||||||
(ert-deftest dag-test-edit-null ()
|
(ert-deftest dag-test-edit-null ()
|
||||||
|
@ -374,7 +355,6 @@
|
||||||
(d :children nil :parents (b c))
|
(d :children nil :parents (b c))
|
||||||
(e :children nil :parents (b c)))
|
(e :children nil :parents (b c)))
|
||||||
nil
|
nil
|
||||||
nil
|
|
||||||
(a c b e d)))
|
(a c b e d)))
|
||||||
|
|
||||||
(ert-deftest dag-test-edit-cancel ()
|
(ert-deftest dag-test-edit-cancel ()
|
||||||
|
@ -392,8 +372,7 @@
|
||||||
(d :children nil :parents (b c))
|
(d :children nil :parents (b c))
|
||||||
(e :children nil :parents (b c)))
|
(e :children nil :parents (b c)))
|
||||||
nil
|
nil
|
||||||
nil
|
(a c b e d)))
|
||||||
(a b c d e)))
|
|
||||||
|
|
||||||
;; TODO add test for transitive reduction
|
;; TODO add test for transitive reduction
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue