-
Notifications
You must be signed in to change notification settings - Fork 0
/
nx-test.el
186 lines (172 loc) · 9.67 KB
/
nx-test.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
(require 'ht)
(require 'nx)
(require 'ert)
(defun nx-test-equal (a b)
"Custom equality predicate for nx nodes in tests."
(cond
((and (hash-table-p a) (hash-table-p b))
(nx--node-equal a b))
((and (listp a) (listp b))
(and (eq (length a) (length b))
(cl-every #'nx-test-equal a b)))
(t (equal a b))))
(ert-deftest test-nx-diff-trees-and-apply-diff-prop-change ()
"Test nx-diff-trees and nx-apply-diff with a property change."
(let* ((tree1 (nx :root (ht (:_nx/id 'root)) (list (nx :child (ht (:_nx/id 'child) (:prop "value"))))))
(tree2 (nx :root (ht (:_nx/id 'root)) (list (nx :child (ht (:_nx/id 'child) (:prop "new-value"))))))
(diffs (nx-diff-trees tree1 tree2))
(applied-tree (nx-apply-diff tree1 diffs)))
(should (= (length diffs) 1))
(should (eq (ht-get (car diffs) :op) :update-props))
(should (nx-test-equal applied-tree tree2))
(should (not (nx-test-equal tree1 applied-tree)))))
(ert-deftest test-nx-constructor ()
"Test the nx constructor function."
(let ((node (nx :div (ht (:class "container")) (list (nx :p (ht) nil)))))
(should (eq (nx-type node) :div))
(should (equal (ht-get (nx-props node) :class) "container"))
(should (= (length (nx-children node)) 1))
(should (eq (nx-type (car (nx-children node))) :p))))
(ert-deftest test-nx?-valid-node ()
(should (nx? (nx :div (ht) nil)))
(should (nx? (nx :div (ht) (list (nx :p (ht) nil)))))
(should-not (nx? (nx :div (ht) (list (nx :p (ht) "Hello")))))
(should-error (nx?-strict (ht)) :type 'error)
(should-error (nx?-strict (nx :div "not a hash table" nil)) :type 'error)
(should-error (nx?-strict (nx :div (ht) (list (nx :p (ht) "Hello")))) :type 'error))
(ert-deftest test-nx-diff-trees-and-apply-diff-add-child ()
"Test nx-diff-trees and nx-apply-diff when adding a child node."
(let* ((existing-child (nx :child (ht (:_nx/id "child-1"))))
(tree1 (nx :root (ht (:_nx/id "root-1")) (list existing-child)))
(new-child (nx :new-child (ht (:prop "value") (:_nx/id "child-2"))))
(tree2 (nx-copy tree1))
(tree2-children (ht-get tree2 :children)))
(setf (ht-get tree2 :children) (append tree2-children (list new-child)))
(let* ((diffs (nx-diff-trees tree1 tree2))
(applied-tree (nx-apply-diff tree1 diffs)))
;; (jujutsu-dev-dump-tree diffs "*nx ert*")
(should (= (length diffs) 1))
(let ((op-map (car diffs)))
(should (equal (ht-get op-map :op) :insert-last))
(should (equal (ht-get op-map :parent-id) "root-1"))
(should (equal (ht-get* op-map :node :type) :new-child))
(should (equal (ht-get* op-map :node :id) "child-2"))
(should (nx-test-equal applied-tree tree2))
(should (not (nx-test-equal tree1 applied-tree)))))))
(ert-deftest test-nx-diff-trees-and-apply-diff-remove-child ()
"Test nx-diff-trees and nx-apply-diff when removing a child node."
(let* ((tree1 (nx :root (ht (:_nx/id 'root)) (list (nx :child1 (ht (:_nx/id 'child-1)))
(nx :child2 (ht (:_nx/id 'child-2))))))
(tree2 (nx :root (ht (:_nx/id 'root)) (list (nx :child1 (ht (:_nx/id 'child-1))))))
(diffs (nx-diff-trees tree1 tree2))
(applied-tree (nx-apply-diff tree1 diffs)))
(should (= (length diffs) 1))
;; (should (eq (caar diff) :remove))
(should (nx-test-equal applied-tree tree2))
(should (not (nx-test-equal tree1 applied-tree)))))
(ert-deftest test-nx-diff-trees-and-apply-diff-replace-node ()
"Test nx-diff-trees and nx-apply-diff when replacing a node."
(let* ((tree1 (nx :root (ht (:_nx/id 'root)) (list (nx :old-child (ht (:_nx/id 'child) (:prop "same"))))))
(tree2 (nx :root (ht (:_nx/id 'root)) (list (nx :new-child (ht (:_nx/id 'child) (:prop "same"))))))
(diffs (nx-diff-trees tree1 tree2))
(applied-tree (nx-apply-diff tree1 diffs)))
(should (= (length diffs) 1))
(let ((op-map (car diffs)))
(should (eq (ht-get op-map :op) :replace))
(should (eq (ht-get op-map :ref-id) 'child))
(should (eq (ht-get* op-map :node :type) :new-child))
(should (nx-test-equal applied-tree tree2))
(should (not (nx-test-equal tree1 applied-tree))))))
(ert-deftest test-nx-diff-trees-and-apply-diff-nested-changes ()
"Test nx-diff-trees and nx-apply-diff with nested changes."
(let* ((tree1 (nx :root (ht (:_nx/id 'root-1))
(list (nx :parent (ht (:_nx/id 'parent-1))
(list (nx :child1 (ht (:_nx/id 'child-1) (:prop "old")))
(nx :child2 (ht (:_nx/id 'child-2))))))))
(tree2 (nx :root (ht (:_nx/id 'root-1))
(list (nx :parent (ht (:_nx/id 'parent-1))
(list (nx :child1 (ht (:_nx/id 'child-1) (:prop "new")))
(nx :child3 (ht (:_nx/id 'child-3))))))))
(diffs (nx-diff-trees tree1 tree2))
(applied-tree (nx-apply-diff tree1 diffs)))
(should (nx-test-equal applied-tree tree2))
(should (not (nx-test-equal tree1 applied-tree)))))
(ert-deftest test-nx-diff-trees-and-apply-diff-no-changes ()
"Test nx-diff-trees and nx-apply-diff when there are no changes."
(let* ((tree (nx :root (ht) (list (nx :child (ht (:prop "value"))))))
(diffs (nx-diff-trees tree tree))
(applied-tree (nx-apply-diff tree diffs)))
(should (null diffs))
(should (nx-test-equal applied-tree tree))))
(ert-deftest test-nx-diff-trees-and-apply-diff-complex-structure ()
"Test nx-diff-trees and nx-apply-diff with a more complex nested structure."
(let* ((tree1 (nx :root (ht (:_nx/id 'root-1))
(list (nx :section (ht (:_nx/id 'section-1))
(list (nx :header (ht (:_nx/id 'header-1)) (list (nx :h1 (ht (:_nx/id 'h1-1)) nil)))
(nx :content (ht (:_nx/id 'content-1)) (list (nx :p (ht (:_nx/id 'p-1) (:class "old")) nil)))))
(nx :footer (ht (:_nx/id 'footer-1)) nil))))
(tree2 (nx :root (ht (:_nx/id 'root-1))
(list (nx :section (ht (:_nx/id 'section-1))
(list (nx :header (ht (:_nx/id 'header-1)) (list (nx :h1 (ht (:_nx/id 'h1-1)) nil)))
(nx :content (ht (:_nx/id 'content-1)) (list (nx :p (ht (:_nx/id 'p-1) (:class "new")) nil)
(nx :span (ht (:_nx/id 'span-2)) nil)))))
(nx :nav (ht (:_nx/id 'nav-2)) nil))))
(diffs (nx-diff-trees tree1 tree2))
(applied-tree (nx-apply-diff tree1 diffs)))
;; (should (= (length diff) 4))
;; (should (member :update (-map #'car diff)))
;; (should (member :remove (-map #'car diff)))
;; (should (= (-count (lambda (x) (eq (car x) :insert)) diff) 2))
(should (nx-test-equal applied-tree tree2))
(should (not (nx-test-equal tree1 applied-tree)))))
;; XXX: currently broken
;; (ert-deftest test-nx-diff-trees-and-apply-diff-reordered-children ()
;; "Test nx-diff-trees and nx-apply-diff with reordered children."
;; (let* ((child-a (nx :a (ht (:_nx/id 'child-a))))
;; (child-b (nx :b (ht (:_nx/id 'child-b))))
;; (child-c (nx :c (ht (:_nx/id 'child-c))))
;; (tree1 (nx :root (ht (:_nx/id 'root))
;; (list child-a child-b child-c)))
;; (tree2 (nx :root (ht (:_nx/id 'root))
;; (list child-c child-a child-b)))
;; (diffs (nx-diff-trees tree1 tree2))
;; (applied-tree (nx-apply-diff tree1 diffs)))
;; ;; (jujutsu-dev-dump-tree (ht (:initial-tree tree1)
;; ;; (:target-tree tree2)
;; ;; (:diff-ops diffs)
;; ;; (:applied-tree applied-tree))
;; ;; "*jj ert*")
;; (should t)
;; ;; (should (nx-test-equal applied-tree tree2))
;; ;; (should (not (nx-test-equal tree1 applied-tree)))
;; ))
;; (ert-deftest test-nx-diff-trees-and-apply-diff-nested-reordering ()
;; "Test nx-diff-trees and nx-apply-diff with nested reordering of children."
;; (let* ((child-a (nx :a (ht (:_nx/id 'child-a))))
;; (child-b (nx :b (ht (:_nx/id 'child-b))))
;; (parent1 (nx :parent1 (ht (:_nx/id 'parent1)) (list child-a child-b)))
;; (parent2 (nx :parent2 (ht (:_nx/id 'parent2)) (list child-b child-a)))
;; (tree1 (nx :root (ht (:_nx/id 'root)) (list parent1 parent2)))
;; (tree2 (nx :root (ht (:_nx/id 'root)) (list parent2 parent1)))
;; (diffs (nx-diff-trees tree1 tree2))
;; (applied-tree (nx-apply-diff tree1 diffs)))
;; (should (nx-test-equal applied-tree tree2))
;; (should (not (nx-test-equal tree1 applied-tree)))))
(ert-deftest test-nx-diff-trees-and-apply-diff-mixed-operations ()
"Test nx-diff-trees and nx-apply-diff with a mix of operations."
(let* ((tree1 (nx :root (ht (:_nx/id 'root))
(list (nx :a (ht (:_nx/id 'a) (:value 1)))
(nx :b (ht (:_nx/id 'b)))
(nx :c (ht (:_nx/id 'c))))))
(tree2 (nx :root (ht (:_nx/id 'root))
(list (nx :a (ht (:_nx/id 'a) (:value 2)))
(nx :d (ht (:_nx/id 'd)))
(nx :c (ht (:_nx/id 'c))))))
(diffs (nx-diff-trees tree1 tree2))
(applied-tree (nx-apply-diff tree1 diffs)))
;; (should (= (length diff) 5))
;; (should (member :update (mapcar #'car diff)))
;; (should (member :remove (mapcar #'car diff)))
;; (should (member :insert (mapcar #'car diff)))
(should (nx-test-equal applied-tree tree2))
(should (not (nx-test-equal tree1 applied-tree)))))