-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathjezebel-util-test.el
199 lines (175 loc) · 7.18 KB
/
jezebel-util-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
187
188
189
190
191
192
193
194
195
196
197
198
199
;; -*- lexical-binding: t -*-
(require 'jezebel-test-util)
(require 'jezebel-util)
(eval-and-compile
(cl-defmacro jezt-functional-struct-test (&rest forms)
"Test a jetz functional struct. Runs FORMS repeatedly,
once for each variety of functional structure.
For each iteration, replace the following symbols with the
ones appropriate for the specific structure being tested:
jezt-fstruct-field1
jezt-fstruct-field2
make-jezt-fstruct
copy-and-modify-jezt-fstruct
"
`(progn
(define-functional-struct (jezt-fstruct-list
(:type list)
(:named))
field1
field2)
(define-functional-struct (jezt-fstruct-vector
(:type vector)
(:named))
field1
field2)
(define-functional-struct (jezt-fstruct-list-unnamed
(:type list))
field1
field2)
(define-functional-struct (jezt-fstruct-vector-unnamed
(:type vector))
field1
field2)
,@(loop for s in '(jezt-fstruct-list
jezt-fstruct-vector
jezt-fstruct-list-unnamed
jezt-fstruct-vector-unnamed)
collect (sublis
(loop for sym in '(jezt-fstruct-field1
jezt-fstruct-field2
make-jezt-fstruct
copy-and-modify-jezt-fstruct)
for sname = (symbol-name sym)
do (when (string-match "jezt-fstruct" sname)
(setf sname
(replace-match (symbol-name s) t t sname)))
collect (cons sym (intern sname)))
(list* 'progn
forms)))))
(jezt-functional-struct-test t))
(ert-deftest jezt-functional-struct-basic ()
"Test basic operation of functional structs."
(jezt-functional-struct-test
(let* ((v1 (make-jezt-fstruct :field1 1 :field2 2))
(v2 (copy-and-modify-jezt-fstruct v1 :field1 3))
(v3 (copy-and-modify-jezt-fstruct v1 :field2 4)))
(should-eql (jezt-fstruct-field1 v1)
(jezt-fstruct-field1 v3))
(should-eql (jezt-fstruct-field2 v2)
(jezt-fstruct-field2 v1))
(should-eql (jezt-fstruct-field1 v2) 3)
(should-eql (jezt-fstruct-field2 v3) 4))))
(ert-deftest jezt-functional-struct-orig ()
"Test `orig' anaphor for original field values in copy-and-modify."
(jezt-functional-struct-test
(let* ((v1 (make-jezt-fstruct :field1 1 :field2 -1))
(v2 (copy-and-modify-jezt-fstruct v1 :field1 (1+ orig))))
(should-eql (jezt-fstruct-field1 v1) 1)
(should-eql (jezt-fstruct-field1 v2) 2))))
(ert-deftest jezt-functional-struct-shared ()
"Test list-based functional struct structure sharing."
;; Called for structure-defining side effects
(jezt-functional-struct-test)
;; Test only list structures
(let* ((v1 (make-jezt-fstruct-list :field1 1 :field2 2))
(v2 (copy-and-modify-jezt-fstruct-list v1 :field1 3)))
;; Test that we share structure when possible
(should (equal (cddr v1) (cddr v2)))
(should-eql (cddr v1) (cddr v2))))
(ert-deftest jezt-functional-struct-eval-time ()
"Test that forms in copy-and-modify functions are not evaluated
when the macro is expanded."
(jezt-functional-struct-test
(cl-macroexpand-all
'(copy-and-modify-jezt-fstruct dummy :field1 (error "blah'")))
(let ((v (make-jezt-fstruct)))
(should-error
(copy-and-modify-jezt-fstruct v
:field1 (error "bleg"))))))
(defstruct jezt-foo-vector a b c)
(defstruct (jezt-foo-list (:type list) (:named)) a b c)
(ert-deftest jezt-jez-slot-value-vector ()
(let ((val (make-jezt-foo-vector :a 1 :b 2 :c 3)))
(should-eql (jez-slot-value 'jezt-foo-vector val 'c) 3)
(setf (jez-slot-value 'jezt-foo-vector val 'c) 4)
(should-eql (jez-slot-value 'jezt-foo-vector val 'c) 4)))
(ert-deftest jezt-jez-slot-value-list ()
(let ((val (make-jezt-foo-list :a 1 :b 2 :c 3)))
(should-eql (jez-slot-value 'jezt-foo-list val 'c) 3)
(setf (jez-slot-value 'jezt-foo-list val 'c) 4)
(should-eql (jez-slot-value 'jezt-foo-list val 'c) 4)))
(ert-deftest jezt-with-struct-slots ()
(let ((val (make-jezt-foo-vector :a 1 :b 2 :c 3)))
(should-equal (jez-with-slots
(a b c) (jezt-foo-vector val)
(list c b a))
(list 3 2 1))))
(ert-deftest jezt-nested-with-struct-slots ()
(let ((val (make-jezt-foo-vector :a 1 :b 2 :c 3))
(val2 (make-jezt-foo-list :a 4 :b 5 :c 6)))
(jez-with-slots (a) (jezt-foo-vector val)
(jez-with-slots (b) (jezt-foo-list val2)
(should-equal (list a b)
(list 1 5))))))
(ert-deftest jezt-combine-ranges ()
(should-equal (jez-combine-ranges nil) nil)
(should-equal (jez-combine-ranges
(copy-sequence '(((1 . 2) a))))
'(((1 . 2) a)))
(should-equal (jez-combine-ranges
(copy-sequence
`(((1 . 6) a)
((4 . 7) b))))
'(((1 . 3) a)
((4 . 6) a b)
((7 . 7) b)))
(should-equal (jez-combine-ranges
(copy-sequence
`(((1 . 1) a)
((1 . 2) b))))
'(((1 . 1) a b)
((2 . 2) b)))
(should-equal (jez-combine-ranges
(copy-sequence
`(((1 . 5) e)
((2 . 5) h))))
'(((1 . 1) e)
((2 . 5) e h)))
(should-equal (jez-combine-ranges
(copy-sequence
`(((1 . 1) a)
((1 . 2) b)
((1 . 3) c)
((1 . 4) d)
((1 . 5) e)
((2 . 4) f)
((7 . 10) g)
((2 . 5) h))))
'(((1 . 1) a b c d e)
((2 . 2) b c d e f h)
((3 . 3) c d e f h)
((4 . 4) d e f h)
((5 . 5) e h)
((7 . 10) g)))
(should-equal (jez-combine-ranges
(copy-sequence
`(((1 . 1) a)
((7 . 7) b))))
`(((1 . 1) a)
((7 . 7) b)))
(should-equal (jez-combine-ranges
(copy-sequence
`(((,most-negative-fixnum . ,(+ 0 most-positive-fixnum)) a)
((4 . ,(+ -1 most-positive-fixnum)) b))))
`(((,most-negative-fixnum . 3) a)
((4 . ,(+ -1 most-positive-fixnum)) a b)
((,most-positive-fixnum . ,most-positive-fixnum) a)))
(should-equal (jez-combine-ranges
(copy-sequence
`(((,most-negative-fixnum . ,most-positive-fixnum) a)
((4 . 7) b))))
`(((,most-negative-fixnum . 3) a)
((4 . 7) a b)
((8 . ,most-positive-fixnum) a))))
(provide 'jezebel-util-test)