aboutsummaryrefslogtreecommitdiffstats
path: root/test/src
diff options
context:
space:
mode:
authorAndrea Corallo2019-07-10 03:06:21 +0200
committerAndrea Corallo2020-01-01 11:33:52 +0100
commit0bd54f29cbf264e0982d3b31b4c313329ae26a27 (patch)
tree735b42e99ee3efafc505287fac4314a105e13e06 /test/src
parent25908f52e16e4a5de86f85945a89fa50c714188d (diff)
downloademacs-0bd54f29cbf264e0982d3b31b4c313329ae26a27.tar.gz
emacs-0bd54f29cbf264e0982d3b31b4c313329ae26a27.zip
two test passing
Diffstat (limited to 'test/src')
-rw-r--r--test/src/comp-tests.el780
1 files changed, 388 insertions, 392 deletions
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 8d3a0f507d3..33f5ebfdc2e 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -32,23 +32,19 @@
32 32
33(defvar comp-tests-var1 3) 33(defvar comp-tests-var1 3)
34 34
35(defun comp-test-compile (f)
36 ;; (byte-compile f)
37 (native-compile f))
38
39(ert-deftest comp-tests-varref () 35(ert-deftest comp-tests-varref ()
40 "Testing varref." 36 "Testing varref."
41 (defun comp-tests-varref-f () 37 (defun comp-tests-varref-f ()
42 comp-tests-var1) 38 comp-tests-var1)
43 39
44 (comp-test-compile #'comp-tests-varref-f) 40 (native-compile #'comp-tests-varref-f)
45 41
46 (should (= (comp-tests-varref-f) 3))) 42 (should (= (comp-tests-varref-f) 3)))
47 43
48(ert-deftest comp-tests-list () 44(ert-deftest comp-tests-list ()
49 "Testing cons car cdr." 45 "Testing cons car cdr."
50 (defun comp-tests-list-f () 46 ;; (defun comp-tests-list-f ()
51 (list 1 2 3)) 47 ;; (list 1 2 3))
52 (defun comp-tests-car-f (x) 48 (defun comp-tests-car-f (x)
53 ;; Bcar 49 ;; Bcar
54 (car x)) 50 (car x))
@@ -62,13 +58,13 @@
62 ;; Bcdr_safe 58 ;; Bcdr_safe
63 (cdr-safe x)) 59 (cdr-safe x))
64 60
65 (comp-test-compile #'comp-tests-list-f) 61 ;; (native-compile #'comp-tests-list-f)
66 (comp-test-compile #'comp-tests-car-f) 62 (native-compile #'comp-tests-car-f)
67 (comp-test-compile #'comp-tests-cdr-f) 63 (native-compile #'comp-tests-cdr-f)
68 (comp-test-compile #'comp-tests-car-safe-f) 64 (native-compile #'comp-tests-car-safe-f)
69 (comp-test-compile #'comp-tests-cdr-safe-f) 65 (native-compile #'comp-tests-cdr-safe-f)
70 66
71 (should (equal (comp-tests-list-f) '(1 2 3))) 67 ;; (should (equal (comp-tests-list-f) '(1 2 3)))
72 (should (= (comp-tests-car-f '(1 . 2)) 1)) 68 (should (= (comp-tests-car-f '(1 . 2)) 1))
73 (should (null (comp-tests-car-f nil))) 69 (should (null (comp-tests-car-f nil)))
74 (should (= (condition-case err 70 (should (= (condition-case err
@@ -86,396 +82,396 @@
86 (should (= (comp-tests-cdr-safe-f '(1 . 2)) 2)) 82 (should (= (comp-tests-cdr-safe-f '(1 . 2)) 2))
87 (should (null (comp-tests-cdr-safe-f 'a)))) 83 (should (null (comp-tests-cdr-safe-f 'a))))
88 84
89(ert-deftest comp-tests-cons-car-cdr () 85;; (ert-deftest comp-tests-cons-car-cdr ()
90 "Testing cons car cdr." 86;; "Testing cons car cdr."
91 (defun comp-tests-cons-car-f () 87;; (defun comp-tests-cons-car-f ()
92 (car (cons 1 2))) 88;; (car (cons 1 2)))
93 (comp-test-compile #'comp-tests-cons-car-f) 89;; (native-compile #'comp-tests-cons-car-f)
94 90
95 (defun comp-tests-cons-cdr-f (x) 91;; (defun comp-tests-cons-cdr-f (x)
96 (cdr (cons 'foo x))) 92;; (cdr (cons 'foo x)))
97 (comp-test-compile #'comp-tests-cons-cdr-f) 93;; (native-compile #'comp-tests-cons-cdr-f)
98 94
99 (should (= (comp-tests-cons-car-f) 1)) 95;; (should (= (comp-tests-cons-car-f) 1))
100 (should (= (comp-tests-cons-cdr-f 3) 3))) 96;; (should (= (comp-tests-cons-cdr-f 3) 3)))
101 97
102(ert-deftest comp-tests-varset () 98;; (ert-deftest comp-tests-varset ()
103 "Testing varset." 99;; "Testing varset."
104 (defun comp-tests-varset-f () 100;; (defun comp-tests-varset-f ()
105 (setq comp-tests-var1 55)) 101;; (setq comp-tests-var1 55))
106 (comp-test-compile #'comp-tests-varset-f) 102;; (native-compile #'comp-tests-varset-f)
107 103
108 (comp-tests-varset-f) 104;; (comp-tests-varset-f)
109 105
110 (should (= comp-tests-var1 55))) 106;; (should (= comp-tests-var1 55)))
111 107
112(ert-deftest comp-tests-length () 108;; (ert-deftest comp-tests-length ()
113 "Testing length." 109;; "Testing length."
114 (defun comp-tests-length-f () 110;; (defun comp-tests-length-f ()
115 (length '(1 2 3))) 111;; (length '(1 2 3)))
116 (comp-test-compile #'comp-tests-length-f) 112;; (native-compile #'comp-tests-length-f)
117 113
118 (should (= (comp-tests-length-f) 3))) 114;; (should (= (comp-tests-length-f) 3)))
119 115
120(ert-deftest comp-tests-aref-aset () 116;; (ert-deftest comp-tests-aref-aset ()
121 "Testing aref and aset." 117;; "Testing aref and aset."
122 (defun comp-tests-aref-aset-f () 118;; (defun comp-tests-aref-aset-f ()
123 (let ((vec [1 2 3])) 119;; (let ((vec [1 2 3]))
124 (aset vec 2 100) 120;; (aset vec 2 100)
125 (aref vec 2))) 121;; (aref vec 2)))
126 (comp-test-compile #'comp-tests-aref-aset-f) 122;; (native-compile #'comp-tests-aref-aset-f)
127 123
128 (should (= (comp-tests-aref-aset-f) 100))) 124;; (should (= (comp-tests-aref-aset-f) 100)))
129 125
130(ert-deftest comp-tests-symbol-value () 126;; (ert-deftest comp-tests-symbol-value ()
131 "Testing aref and aset." 127;; "Testing aref and aset."
132 (defvar comp-tests-var2 3) 128;; (defvar comp-tests-var2 3)
133 (defun comp-tests-symbol-value-f () 129;; (defun comp-tests-symbol-value-f ()
134 (symbol-value 'comp-tests-var2)) 130;; (symbol-value 'comp-tests-var2))
135 (comp-test-compile #'comp-tests-symbol-value-f) 131;; (native-compile #'comp-tests-symbol-value-f)
136 132
137 (should (= (comp-tests-symbol-value-f) 3))) 133;; (should (= (comp-tests-symbol-value-f) 3)))
138 134
139(ert-deftest comp-tests-concat () 135;; (ert-deftest comp-tests-concat ()
140 "Testing concatX opcodes." 136;; "Testing concatX opcodes."
141 (defun comp-tests-concat-f (x) 137;; (defun comp-tests-concat-f (x)
142 (concat "a" "b" "c" "d" 138;; (concat "a" "b" "c" "d"
143 (concat "a" "b" "c" (concat "a" "b" (concat "foo" x))))) 139;; (concat "a" "b" "c" (concat "a" "b" (concat "foo" x)))))
144 (comp-test-compile #'comp-tests-concat-f) 140;; (native-compile #'comp-tests-concat-f)
145 141
146 (should (string= (comp-tests-concat-f "bar") "abcdabcabfoobar"))) 142;; (should (string= (comp-tests-concat-f "bar") "abcdabcabfoobar")))
147 143
148(ert-deftest comp-tests-ffuncall () 144;; (ert-deftest comp-tests-ffuncall ()
149 "Test calling conventions." 145;; "Test calling conventions."
150 (defun comp-tests-ffuncall-callee-f (x y z) 146;; (defun comp-tests-ffuncall-callee-f (x y z)
151 (list x y z)) 147;; (list x y z))
152 (defun comp-tests-ffuncall-caller-f () 148;; (defun comp-tests-ffuncall-caller-f ()
153 (comp-tests-ffuncall-callee-f 1 2 3)) 149;; (comp-tests-ffuncall-callee-f 1 2 3))
154 150
155 (comp-test-compile #'comp-tests-ffuncall-caller-f) 151;; (native-compile #'comp-tests-ffuncall-caller-f)
156 152
157 (should (equal (comp-tests-ffuncall-caller-f) '(1 2 3))) 153;; (should (equal (comp-tests-ffuncall-caller-f) '(1 2 3)))
158 154
159 (defun comp-tests-ffuncall-callee-optional-f (a b &optional c d) 155;; (defun comp-tests-ffuncall-callee-optional-f (a b &optional c d)
160 (list a b c d)) 156;; (list a b c d))
161 (comp-test-compile #'comp-tests-ffuncall-callee-optional-f) 157;; (native-compile #'comp-tests-ffuncall-callee-optional-f)
162 158
163 (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3 4) '(1 2 3 4))) 159;; (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3 4) '(1 2 3 4)))
164 (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3) '(1 2 3 nil))) 160;; (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3) '(1 2 3 nil)))
165 (should (equal (comp-tests-ffuncall-callee-optional-f 1 2) '(1 2 nil nil))) 161;; (should (equal (comp-tests-ffuncall-callee-optional-f 1 2) '(1 2 nil nil)))
166 162
167 (defun comp-tests-ffuncall-callee-rest-f (a b &rest c) 163;; (defun comp-tests-ffuncall-callee-rest-f (a b &rest c)
168 (list a b c)) 164;; (list a b c))
169 (comp-test-compile #'comp-tests-ffuncall-callee-rest-f) 165;; (native-compile #'comp-tests-ffuncall-callee-rest-f)
170 166
171 (should (equal (comp-tests-ffuncall-callee-rest-f 1 2) '(1 2 nil))) 167;; (should (equal (comp-tests-ffuncall-callee-rest-f 1 2) '(1 2 nil)))
172 (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3) '(1 2 (3)))) 168;; (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3) '(1 2 (3))))
173 (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3 4) '(1 2 (3 4)))) 169;; (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3 4) '(1 2 (3 4))))
174 170
175 (defun comp-tests-ffuncall-native-f () 171;; (defun comp-tests-ffuncall-native-f ()
176 "Call a primitive with no dedicate op." 172;; "Call a primitive with no dedicate op."
177 (make-vector 1 nil)) 173;; (make-vector 1 nil))
178 174
179 (comp-test-compile #'comp-tests-ffuncall-native-f) 175;; (native-compile #'comp-tests-ffuncall-native-f)
180 176
181 (should (equal (comp-tests-ffuncall-native-f) [nil])) 177;; (should (equal (comp-tests-ffuncall-native-f) [nil]))
182 178
183 (defun comp-tests-ffuncall-native-rest-f () 179;; (defun comp-tests-ffuncall-native-rest-f ()
184 "Call a primitive with no dedicate op with &rest." 180;; "Call a primitive with no dedicate op with &rest."
185 (vector 1 2 3)) 181;; (vector 1 2 3))
186 182
187 (comp-test-compile #'comp-tests-ffuncall-native-rest-f) 183;; (native-compile #'comp-tests-ffuncall-native-rest-f)
188 184
189 (should (equal (comp-tests-ffuncall-native-rest-f) [1 2 3])) 185;; (should (equal (comp-tests-ffuncall-native-rest-f) [1 2 3]))
190 186
191 (defun comp-tests-ffuncall-apply-many-f (x) 187;; (defun comp-tests-ffuncall-apply-many-f (x)
192 (apply #'list x)) 188;; (apply #'list x))
193 189
194 (comp-test-compile #'comp-tests-ffuncall-apply-many-f) 190;; (native-compile #'comp-tests-ffuncall-apply-many-f)
195 191
196 (should (equal (comp-tests-ffuncall-apply-many-f '(1 2 3)) '(1 2 3))) 192;; (should (equal (comp-tests-ffuncall-apply-many-f '(1 2 3)) '(1 2 3)))
197 193
198 (defun comp-tests-ffuncall-lambda-f (x) 194;; (defun comp-tests-ffuncall-lambda-f (x)
199 (let ((fun (lambda (x) 195;; (let ((fun (lambda (x)
200 (1+ x)))) 196;; (1+ x))))
201 (funcall fun x))) 197;; (funcall fun x)))
202 198
203 (comp-test-compile #'comp-tests-ffuncall-lambda-f) 199;; (native-compile #'comp-tests-ffuncall-lambda-f)
204 200
205 (should (= (comp-tests-ffuncall-lambda-f 1) 2))) 201;; (should (= (comp-tests-ffuncall-lambda-f 1) 2)))
206 202
207(ert-deftest comp-tests-jump-table () 203;; (ert-deftest comp-tests-jump-table ()
208 "Testing jump tables" 204;; "Testing jump tables"
209 (defun comp-tests-jump-table-1-f (x) 205;; (defun comp-tests-jump-table-1-f (x)
210 (pcase x 206;; (pcase x
211 ('x 'a) 207;; ('x 'a)
212 ('y 'b) 208;; ('y 'b)
213 (_ 'c))) 209;; (_ 'c)))
214 210
215 211
216 (should (eq (comp-tests-jump-table-1-f 'x) 'a)) 212;; (should (eq (comp-tests-jump-table-1-f 'x) 'a))
217 (should (eq (comp-tests-jump-table-1-f 'y) 'b)) 213;; (should (eq (comp-tests-jump-table-1-f 'y) 'b))
218 (should (eq (comp-tests-jump-table-1-f 'xxx) 'c))) 214;; (should (eq (comp-tests-jump-table-1-f 'xxx) 'c)))
219 215
220(ert-deftest comp-tests-conditionals () 216;; (ert-deftest comp-tests-conditionals ()
221 "Testing conditionals." 217;; "Testing conditionals."
222 (defun comp-tests-conditionals-1-f (x) 218;; (defun comp-tests-conditionals-1-f (x)
223 ;; Generate goto-if-nil 219;; ;; Generate goto-if-nil
224 (if x 1 2)) 220;; (if x 1 2))
225 (defun comp-tests-conditionals-2-f (x) 221;; (defun comp-tests-conditionals-2-f (x)
226 ;; Generate goto-if-nil-else-pop 222;; ;; Generate goto-if-nil-else-pop
227 (when x 223;; (when x
228 1340)) 224;; 1340))
229 (comp-test-compile #'comp-tests-conditionals-1-f) 225;; (native-compile #'comp-tests-conditionals-1-f)
230 (comp-test-compile #'comp-tests-conditionals-2-f) 226;; (native-compile #'comp-tests-conditionals-2-f)
231 227
232 (should (= (comp-tests-conditionals-1-f t) 1)) 228;; (should (= (comp-tests-conditionals-1-f t) 1))
233 (should (= (comp-tests-conditionals-1-f nil) 2)) 229;; (should (= (comp-tests-conditionals-1-f nil) 2))
234 (should (= (comp-tests-conditionals-2-f t) 1340)) 230;; (should (= (comp-tests-conditionals-2-f t) 1340))
235 (should (eq (comp-tests-conditionals-2-f nil) nil))) 231;; (should (eq (comp-tests-conditionals-2-f nil) nil)))
236 232
237(ert-deftest comp-tests-fixnum () 233;; (ert-deftest comp-tests-fixnum ()
238 "Testing some fixnum inline operation." 234;; "Testing some fixnum inline operation."
239 (defun comp-tests-fixnum-1-minus-f (x) 235;; (defun comp-tests-fixnum-1-minus-f (x)
240 ;; Bsub1 236;; ;; Bsub1
241 (1- x)) 237;; (1- x))
242 (defun comp-tests-fixnum-1-plus-f (x) 238;; (defun comp-tests-fixnum-1-plus-f (x)
243 ;; Badd1 239;; ;; Badd1
244 (1+ x)) 240;; (1+ x))
245 (defun comp-tests-fixnum-minus-f (x) 241;; (defun comp-tests-fixnum-minus-f (x)
246 ;; Bnegate 242;; ;; Bnegate
247 (- x)) 243;; (- x))
248 244
249 (comp-test-compile #'comp-tests-fixnum-1-minus-f) 245;; (native-compile #'comp-tests-fixnum-1-minus-f)
250 (comp-test-compile #'comp-tests-fixnum-1-plus-f) 246;; (native-compile #'comp-tests-fixnum-1-plus-f)
251 (comp-test-compile #'comp-tests-fixnum-minus-f) 247;; (native-compile #'comp-tests-fixnum-minus-f)
252 248
253 (should (= (comp-tests-fixnum-1-minus-f 10) 9)) 249;; (should (= (comp-tests-fixnum-1-minus-f 10) 9))
254 (should (= (comp-tests-fixnum-1-minus-f most-negative-fixnum) 250;; (should (= (comp-tests-fixnum-1-minus-f most-negative-fixnum)
255 (1- most-negative-fixnum))) 251;; (1- most-negative-fixnum)))
256 (should (equal (condition-case err 252;; (should (equal (condition-case err
257 (comp-tests-fixnum-1-minus-f 'a) 253;; (comp-tests-fixnum-1-minus-f 'a)
258 (error err)) 254;; (error err))
259 '(wrong-type-argument number-or-marker-p a))) 255;; '(wrong-type-argument number-or-marker-p a)))
260 (should (= (comp-tests-fixnum-1-plus-f 10) 11)) 256;; (should (= (comp-tests-fixnum-1-plus-f 10) 11))
261 (should (= (comp-tests-fixnum-1-plus-f most-positive-fixnum) 257;; (should (= (comp-tests-fixnum-1-plus-f most-positive-fixnum)
262 (1+ most-positive-fixnum))) 258;; (1+ most-positive-fixnum)))
263 (should (equal (condition-case err 259;; (should (equal (condition-case err
264 (comp-tests-fixnum-1-plus-f 'a) 260;; (comp-tests-fixnum-1-plus-f 'a)
265 (error err)) 261;; (error err))
266 '(wrong-type-argument number-or-marker-p a))) 262;; '(wrong-type-argument number-or-marker-p a)))
267 (should (= (comp-tests-fixnum-minus-f 10) -10)) 263;; (should (= (comp-tests-fixnum-minus-f 10) -10))
268 (should (= (comp-tests-fixnum-minus-f most-negative-fixnum) 264;; (should (= (comp-tests-fixnum-minus-f most-negative-fixnum)
269 (- most-negative-fixnum))) 265;; (- most-negative-fixnum)))
270 (should (equal (condition-case err 266;; (should (equal (condition-case err
271 (comp-tests-fixnum-minus-f 'a) 267;; (comp-tests-fixnum-minus-f 'a)
272 (error err)) 268;; (error err))
273 '(wrong-type-argument number-or-marker-p a)))) 269;; '(wrong-type-argument number-or-marker-p a))))
274 270
275(ert-deftest comp-tests-arith-comp () 271;; (ert-deftest comp-tests-arith-comp ()
276 "Testing arithmetic comparisons." 272;; "Testing arithmetic comparisons."
277 (defun comp-tests-eqlsign-f (x y) 273;; (defun comp-tests-eqlsign-f (x y)
278 ;; Beqlsign 274;; ;; Beqlsign
279 (= x y)) 275;; (= x y))
280 (defun comp-tests-gtr-f (x y) 276;; (defun comp-tests-gtr-f (x y)
281 ;; Bgtr 277;; ;; Bgtr
282 (> x y)) 278;; (> x y))
283 (defun comp-tests-lss-f (x y) 279;; (defun comp-tests-lss-f (x y)
284 ;; Blss 280;; ;; Blss
285 (< x y)) 281;; (< x y))
286 (defun comp-tests-les-f (x y) 282;; (defun comp-tests-les-f (x y)
287 ;; Bleq 283;; ;; Bleq
288 (<= x y)) 284;; (<= x y))
289 (defun comp-tests-geq-f (x y) 285;; (defun comp-tests-geq-f (x y)
290 ;; Bgeq 286;; ;; Bgeq
291 (>= x y)) 287;; (>= x y))
292 288
293 289
294 (comp-test-compile #'comp-tests-eqlsign-f) 290;; (native-compile #'comp-tests-eqlsign-f)
295 (comp-test-compile #'comp-tests-gtr-f) 291;; (native-compile #'comp-tests-gtr-f)
296 (comp-test-compile #'comp-tests-lss-f) 292;; (native-compile #'comp-tests-lss-f)
297 (comp-test-compile #'comp-tests-les-f) 293;; (native-compile #'comp-tests-les-f)
298 (comp-test-compile #'comp-tests-geq-f) 294;; (native-compile #'comp-tests-geq-f)
299 295
300 (should (eq (comp-tests-eqlsign-f 4 3) nil)) 296;; (should (eq (comp-tests-eqlsign-f 4 3) nil))
301 (should (eq (comp-tests-eqlsign-f 3 3) t)) 297;; (should (eq (comp-tests-eqlsign-f 3 3) t))
302 (should (eq (comp-tests-eqlsign-f 2 3) nil)) 298;; (should (eq (comp-tests-eqlsign-f 2 3) nil))
303 (should (eq (comp-tests-gtr-f 4 3) t)) 299;; (should (eq (comp-tests-gtr-f 4 3) t))
304 (should (eq (comp-tests-gtr-f 3 3) nil)) 300;; (should (eq (comp-tests-gtr-f 3 3) nil))
305 (should (eq (comp-tests-gtr-f 2 3) nil)) 301;; (should (eq (comp-tests-gtr-f 2 3) nil))
306 (should (eq (comp-tests-lss-f 4 3) nil)) 302;; (should (eq (comp-tests-lss-f 4 3) nil))
307 (should (eq (comp-tests-lss-f 3 3) nil)) 303;; (should (eq (comp-tests-lss-f 3 3) nil))
308 (should (eq (comp-tests-lss-f 2 3) t)) 304;; (should (eq (comp-tests-lss-f 2 3) t))
309 (should (eq (comp-tests-les-f 4 3) nil)) 305;; (should (eq (comp-tests-les-f 4 3) nil))
310 (should (eq (comp-tests-les-f 3 3) t)) 306;; (should (eq (comp-tests-les-f 3 3) t))
311 (should (eq (comp-tests-les-f 2 3) t)) 307;; (should (eq (comp-tests-les-f 2 3) t))
312 (should (eq (comp-tests-geq-f 4 3) t)) 308;; (should (eq (comp-tests-geq-f 4 3) t))
313 (should (eq (comp-tests-geq-f 3 3) t)) 309;; (should (eq (comp-tests-geq-f 3 3) t))
314 (should (eq (comp-tests-geq-f 2 3) nil))) 310;; (should (eq (comp-tests-geq-f 2 3) nil)))
315 311
316(ert-deftest comp-tests-setcarcdr () 312;; (ert-deftest comp-tests-setcarcdr ()
317 "Testing setcar setcdr." 313;; "Testing setcar setcdr."
318 (defun comp-tests-setcar-f (x y) 314;; (defun comp-tests-setcar-f (x y)
319 (setcar x y) 315;; (setcar x y)
320 x) 316;; x)
321 (defun comp-tests-setcdr-f (x y) 317;; (defun comp-tests-setcdr-f (x y)
322 (setcdr x y) 318;; (setcdr x y)
323 x) 319;; x)
324 320
325 (comp-test-compile #'comp-tests-setcar-f) 321;; (native-compile #'comp-tests-setcar-f)
326 (comp-test-compile #'comp-tests-setcdr-f) 322;; (native-compile #'comp-tests-setcdr-f)
327 323
328 (should (equal (comp-tests-setcar-f '(10 . 10) 3) '(3 . 10))) 324;; (should (equal (comp-tests-setcar-f '(10 . 10) 3) '(3 . 10)))
329 (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3))) 325;; (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3)))
330 (should (equal (condition-case 326;; (should (equal (condition-case
331 err 327;; err
332 (comp-tests-setcar-f 3 10) 328;; (comp-tests-setcar-f 3 10)
333 (error err)) 329;; (error err))
334 '(wrong-type-argument consp 3))) 330;; '(wrong-type-argument consp 3)))
335 (should (equal (condition-case 331;; (should (equal (condition-case
336 err 332;; err
337 (comp-tests-setcdr-f 3 10) 333;; (comp-tests-setcdr-f 3 10)
338 (error err)) 334;; (error err))
339 '(wrong-type-argument consp 3)))) 335;; '(wrong-type-argument consp 3))))
340 336
341(ert-deftest comp-tests-bubble-sort () 337;; (ert-deftest comp-tests-bubble-sort ()
342 "Run bubble sort." 338;; "Run bubble sort."
343 (defun comp-bubble-sort-f (list) 339;; (defun comp-bubble-sort-f (list)
344 (let ((i (length list))) 340;; (let ((i (length list)))
345 (while (> i 1) 341;; (while (> i 1)
346 (let ((b list)) 342;; (let ((b list))
347 (while (cdr b) 343;; (while (cdr b)
348 (when (< (cadr b) (car b)) 344;; (when (< (cadr b) (car b))
349 (setcar b (prog1 (cadr b) 345;; (setcar b (prog1 (cadr b)
350 (setcdr b (cons (car b) (cddr b)))))) 346;; (setcdr b (cons (car b) (cddr b))))))
351 (setq b (cdr b)))) 347;; (setq b (cdr b))))
352 (setq i (1- i))) 348;; (setq i (1- i)))
353 list)) 349;; list))
354 350
355 (comp-test-compile #'comp-bubble-sort-f) 351;; (native-compile #'comp-bubble-sort-f)
356 352
357 (let* ((list1 (mapcar 'random (make-list 1000 most-positive-fixnum))) 353;; (let* ((list1 (mapcar 'random (make-list 1000 most-positive-fixnum)))
358 (list2 (copy-sequence list1))) 354;; (list2 (copy-sequence list1)))
359 (should (equal (comp-bubble-sort-f list1) 355;; (should (equal (comp-bubble-sort-f list1)
360 (sort list2 #'<))))) 356;; (sort list2 #'<)))))
361 357
362(ert-deftest comp-tests-list-inline () 358;; (ert-deftest comp-tests-list-inline ()
363 "Test some inlined list functions." 359;; "Test some inlined list functions."
364 (defun comp-tests-consp-f (x) 360;; (defun comp-tests-consp-f (x)
365 ;; Bconsp 361;; ;; Bconsp
366 (consp x)) 362;; (consp x))
367 (defun comp-tests-car-f (x) 363;; (defun comp-tests-car-f (x)
368 ;; Bsetcar 364;; ;; Bsetcar
369 (setcar x 3)) 365;; (setcar x 3))
370 366
371 (comp-test-compile #'comp-tests-consp-f) 367;; (native-compile #'comp-tests-consp-f)
372 (comp-test-compile #'comp-tests-car-f) 368;; (native-compile #'comp-tests-car-f)
373 369
374 (should (eq (comp-tests-consp-f '(1)) t)) 370;; (should (eq (comp-tests-consp-f '(1)) t))
375 (should (eq (comp-tests-consp-f 1) nil)) 371;; (should (eq (comp-tests-consp-f 1) nil))
376 (let ((x (cons 1 2))) 372;; (let ((x (cons 1 2)))
377 (should (= (comp-tests-car-f x) 3)) 373;; (should (= (comp-tests-car-f x) 3))
378 (should (equal x '(3 . 2))))) 374;; (should (equal x '(3 . 2)))))
379 375
380(ert-deftest comp-tests-num-inline () 376;; (ert-deftest comp-tests-num-inline ()
381 "Test some inlined number functions." 377;; "Test some inlined number functions."
382 (defun comp-tests-integerp-f (x) 378;; (defun comp-tests-integerp-f (x)
383 ;; Bintegerp 379;; ;; Bintegerp
384 (integerp x)) 380;; (integerp x))
385 (defun comp-tests-numberp-f (x) 381;; (defun comp-tests-numberp-f (x)
386 ;; Bnumberp 382;; ;; Bnumberp
387 (numberp x)) 383;; (numberp x))
388 384
389 (comp-test-compile #'comp-tests-integerp-f) 385;; (native-compile #'comp-tests-integerp-f)
390 (comp-test-compile #'comp-tests-numberp-f) 386;; (native-compile #'comp-tests-numberp-f)
391 387
392 (should (eq (comp-tests-integerp-f 1) t)) 388;; (should (eq (comp-tests-integerp-f 1) t))
393 (should (eq (comp-tests-integerp-f '(1)) nil)) 389;; (should (eq (comp-tests-integerp-f '(1)) nil))
394 (should (eq (comp-tests-integerp-f 3.5) nil)) 390;; (should (eq (comp-tests-integerp-f 3.5) nil))
395 (should (eq (comp-tests-integerp-f (1+ most-negative-fixnum)) t)) 391;; (should (eq (comp-tests-integerp-f (1+ most-negative-fixnum)) t))
396 392
397 (should (eq (comp-tests-numberp-f 1) t)) 393;; (should (eq (comp-tests-numberp-f 1) t))
398 (should (eq (comp-tests-numberp-f 'a) nil)) 394;; (should (eq (comp-tests-numberp-f 'a) nil))
399 (should (eq (comp-tests-numberp-f 3.5) t))) 395;; (should (eq (comp-tests-numberp-f 3.5) t)))
400 396
401(ert-deftest comp-tests-stack () 397;; (ert-deftest comp-tests-stack ()
402 "Test some stack operation." 398;; "Test some stack operation."
403 (defun comp-tests-discardn-f (x) 399;; (defun comp-tests-discardn-f (x)
404 ;; BdiscardN 400;; ;; BdiscardN
405 (1+ (let ((a 1) 401;; (1+ (let ((a 1)
406 (_b) 402;; (_b)
407 (_c)) 403;; (_c))
408 a))) 404;; a)))
409 (defun comp-tests-insertn-f (a b c d) 405;; (defun comp-tests-insertn-f (a b c d)
410 ;; Binsert 406;; ;; Binsert
411 (insert a b c d)) 407;; (insert a b c d))
412 408
413 (comp-test-compile #'comp-tests-discardn-f) 409;; (native-compile #'comp-tests-discardn-f)
414 (comp-test-compile #'comp-tests-insertn-f) 410;; (native-compile #'comp-tests-insertn-f)
415 411
416 (should (= (comp-tests-discardn-f 10) 2)) 412;; (should (= (comp-tests-discardn-f 10) 2))
417 413
418 (should (string= (with-temp-buffer 414;; (should (string= (with-temp-buffer
419 (comp-tests-insertn-f "a" "b" "c" "d") 415;; (comp-tests-insertn-f "a" "b" "c" "d")
420 (buffer-string)) 416;; (buffer-string))
421 "abcd"))) 417;; "abcd")))
422 418
423(ert-deftest comp-tests-non-locals () 419;; (ert-deftest comp-tests-non-locals ()
424 "Test non locals." 420;; "Test non locals."
425 (defun comp-tests-err-arith-f () 421;; (defun comp-tests-err-arith-f ()
426 (/ 1 0)) 422;; (/ 1 0))
427 (defun comp-tests-err-foo-f () 423;; (defun comp-tests-err-foo-f ()
428 (error "foo")) 424;; (error "foo"))
429 425
430 (defun comp-tests-condition-case-0-f () 426;; (defun comp-tests-condition-case-0-f ()
431 ;; Bpushhandler Bpophandler 427;; ;; Bpushhandler Bpophandler
432 (condition-case 428;; (condition-case
433 err 429;; err
434 (comp-tests-err-arith-f) 430;; (comp-tests-err-arith-f)
435 (arith-error (concat "arith-error " 431;; (arith-error (concat "arith-error "
436 (error-message-string err) 432;; (error-message-string err)
437 " catched")) 433;; " catched"))
438 (error (concat "error " 434;; (error (concat "error "
439 (error-message-string err) 435;; (error-message-string err)
440 " catched")))) 436;; " catched"))))
441 437
442 (defun comp-tests-condition-case-1-f () 438;; (defun comp-tests-condition-case-1-f ()
443 ;; Bpushhandler Bpophandler 439;; ;; Bpushhandler Bpophandler
444 (condition-case 440;; (condition-case
445 err 441;; err
446 (comp-tests-err-foo-f) 442;; (comp-tests-err-foo-f)
447 (arith-error (concat "arith-error " 443;; (arith-error (concat "arith-error "
448 (error-message-string err) 444;; (error-message-string err)
449 " catched")) 445;; " catched"))
450 (error (concat "error " 446;; (error (concat "error "
451 (error-message-string err) 447;; (error-message-string err)
452 " catched")))) 448;; " catched"))))
453 449
454 (defun comp-tests-catch-f (f) 450;; (defun comp-tests-catch-f (f)
455 (catch 'foo 451;; (catch 'foo
456 (funcall f))) 452;; (funcall f)))
457 453
458 (defun comp-tests-throw-f (x) 454;; (defun comp-tests-throw-f (x)
459 (throw 'foo x)) 455;; (throw 'foo x))
460 456
461 (comp-test-compile #'comp-tests-condition-case-0-f) 457;; (native-compile #'comp-tests-condition-case-0-f)
462 (comp-test-compile #'comp-tests-condition-case-1-f) 458;; (native-compile #'comp-tests-condition-case-1-f)
463 (comp-test-compile #'comp-tests-catch-f) 459;; (native-compile #'comp-tests-catch-f)
464 (comp-test-compile #'comp-tests-throw-f) 460;; (native-compile #'comp-tests-throw-f)
465 461
466 (should (string= (comp-tests-condition-case-0-f) 462;; (should (string= (comp-tests-condition-case-0-f)
467 "arith-error Arithmetic error catched")) 463;; "arith-error Arithmetic error catched"))
468 (should (string= (comp-tests-condition-case-1-f) 464;; (should (string= (comp-tests-condition-case-1-f)
469 "error foo catched")) 465;; "error foo catched"))
470 (should (= (comp-tests-catch-f (lambda () (throw 'foo 3))) 3)) 466;; (should (= (comp-tests-catch-f (lambda () (throw 'foo 3))) 3))
471 (should (= (catch 'foo 467;; (should (= (catch 'foo
472 (comp-tests-throw-f 3))))) 468;; (comp-tests-throw-f 3)))))
473 469
474(ert-deftest comp-tests-gc () 470;; (ert-deftest comp-tests-gc ()
475 "Try to do some longer computation to let the gc kick in." 471;; "Try to do some longer computation to let the gc kick in."
476 (dotimes (_ 100000) 472;; (dotimes (_ 100000)
477 (comp-tests-cons-cdr-f 3)) 473;; (comp-tests-cons-cdr-f 3))
478 474
479 (should (= (comp-tests-cons-cdr-f 3) 3))) 475;; (should (= (comp-tests-cons-cdr-f 3) 3)))
480 476
481;;; comp-tests.el ends here 477;;; comp-tests.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-03-06 12:42:41 +0000