-
Notifications
You must be signed in to change notification settings - Fork 12
/
Copy pathkunit.kl
executable file
·487 lines (426 loc) · 11.4 KB
/
kunit.kl
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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
PROGRAM kunit
%NOLOCKGROUP
%UNINITVARS
CONST
VERSION = '1.0.0'
LINE_WRAP = 40
PIPE_FILE = 'PIP:KUNIT.DAT'
FAIL_FILE = 'PIP:KUNIT_FAIL.DAT'
PROG_PIPE = 'PIP:KUNIT_PROGRESS.DAT'
KUNIT_SEMA = 1
MAX_WAIT = 1000
VAR
response : FILE
pipe_f : FILE
other_f : FILE
fail_f : FILE
prog_f : FILE
test_count : INTEGER
fail_count : INTEGER
pass_count : INTEGER
assrtn_count : INTEGER
error_msg : STRING[254]
filenames : STRING[254]
filenames_a : ARRAY[16] OF STRING[16]
timeout : BOOLEAN
task_count : INTEGER
i : INTEGER
output : STRING[12]
url : STRING[254]
start_time : INTEGER
end_time : INTEGER
total_time : REAL
entry : INTEGER
status : INTEGER
%INCLUDE includes/vendor/strings.h
-- Private: Initialize KUNIT
ROUTINE kunit_init
BEGIN
GET_VAR(entry, '*system*', '$fast_clock', start_time, status)
IF UNINIT(output) THEN output = ''; ENDIF
IF UNINIT(filenames) THEN filenames = ''; ENDIF
OPEN FILE response ('RW', 'RD:RESPONSE.HTM')
-- empty fail_f
OPEN FILE fail_f ('RW', FAIL_FILE)
CLOSE FILE fail_f
-- empty prog_pipe
OPEN FILE prog_f ('RW', PROG_PIPE)
CLOSE file prog_f
IF output = 'html' THEN
WRITE response (
'<!DOCTYPE html>',
'<html><head>',
'<title>KUnit v',VERSION,'</title>',
'<style>body { padding: 20px; }</style>',
'<meta charset="UTF-8" />',
'</head><body>',
'<pre>', CR)
ENDIF
WRITE response ('KUnit v', VERSION, CR, CR)
test_count = 0
fail_count = 0
pass_count = 0
assrtn_count = 0
task_count = 0
CLEAR_SEMA(KUNIT_SEMA)
END kunit_init
-- Private: Fail a test
ROUTINE kunit_fail(name : STRING)
BEGIN
fail_count = fail_count + 1
OPEN FILE fail_f ('AP', FAIL_FILE)
WRITE fail_f (fail_count, ') Failure:', CR)
WRITE fail_f (name, CR)
WRITE fail_f (error_msg,CR,CR)
CLOSE FILE fail_f
END kunit_fail
-- Private: pass a test
ROUTINE kunit_pass
BEGIN
pass_count = pass_count + 1
END kunit_pass
-- Public: Perform a test
--
-- name - A STRING describing what this test is testing
-- result - A BOOLEAN that determines if the test passes or fails
--
-- Examples
--
-- kunit_test('true should pass', true)
-- # => test passes
--
-- kunit_test('this test should fail', false)
-- # => test fails
ROUTINE kunit_test(name : STRING; result : BOOLEAN)
BEGIN
test_count = test_count + 1
OPEN FILE prog_f ('AP', PROG_PIPE)
IF result THEN
WRITE prog_f ('.')
kunit_pass
ELSE
WRITE prog_f ('F')
kunit_fail(name)
ENDIF
IF ((pass_count+fail_count) MOD LINE_WRAP = 0) THEN
WRITE prog_f (CR)
ENDIF
CLOSE FILE prog_f
END kunit_test
-- Public: tell the test runner that this file is finished
ROUTINE kunit_done
BEGIN
POST_SEMA(KUNIT_SEMA)
END kunit_done
-- Public: Assert that something is true
--
-- actual - A BOOLEAN value
--
-- Examples
--
-- kunit_assert(true)
-- # => true
--
-- kunit_assert(false)
-- # => false
ROUTINE kunit_assert_t(actual : BOOLEAN) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF actual THEN
RETURN(true)
ELSE
error_msg = 'Expected true but got false'
RETURN(false)
ENDIF
END kunit_assert_t
-- Public: Assert that something is false
--
-- actual - A BOOLEAN value
--
-- Examples
--
-- kunit_assert_f(true)
-- # => false
--
-- kunit_assert_f(false)
-- # => true
ROUTINE kunit_assert_f(actual : BOOLEAN) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF NOT actual THEN
RETURN(true)
ELSE
error_msg = 'Expected false but got true'
RETURN(false)
ENDIF
END kunit_assert_f
-- Public: Assert that two INTEGERs are equal
--
-- expected - The expected INTEGER value
-- actual - The actual INTEGER value
--
-- Examples
--
-- kunit_eq_int(1,1)
-- # => true
--
-- kunit_eq_int(1,2)
-- # => False
ROUTINE kunit_eq_int(expected : INTEGER; actual : INTEGER) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF UNINIT(actual) THEN
error_msg = 'Expected ' + i_to_s(expected) + ' but got UNINIT'
RETURN(false)
ENDIF
IF expected=actual THEN
RETURN(true)
ELSE
error_msg = 'Expected ' + i_to_s(expected) + ' but got ' + i_to_s(actual)
RETURN(false)
ENDIF
END kunit_eq_int
ROUTINE kunit_un_int(actual : INTEGER) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF UNINIT(actual) THEN
RETURN(true)
ELSE
error_msg = 'Expected UNINIT but got ' + i_to_s(actual)
RETURN(false)
ENDIF
END kunit_un_int
ROUTINE kunit_un_str(actual : STRING) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF UNINIT(actual) THEN
RETURN(true)
ELSE
error_msg = 'Expected UNINIT but got "' + actual + '"'
RETURN(false)
ENDIF
END kunit_un_str
ROUTINE kunit_un_r(actual : REAL) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF UNINIT(actual) THEN
RETURN(true)
ELSE
error_msg = 'Expected UNINIT but got ' + r_to_s(actual)
RETURN(false)
ENDIF
END kunit_un_r
ROUTINE kunit_eq_r(expected : REAL; actual : REAL) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF expected=actual THEN
RETURN(true)
ELSE
error_msg = 'Expected ' + r_to_s(expected) + ' but got ' + r_to_s(actual)
RETURN(false)
ENDIF
END kunit_eq_r
-- Public: Assert that two STRINGs are equal
--
-- expected - The expected STRING value
-- actual - The actual STRING value
--
-- Examples
--
-- kunit_eq_str('foo','foo')
-- # => true
--
-- kunit_eq_str('foo','bar')
-- # => false
ROUTINE kunit_eq_str(expected : STRING; actual : STRING) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF UNINIT(expected) THEN
error_msg = 'Expected was UNINIT'
RETURN(false)
ENDIF
IF UNINIT(actual) THEN
error_msg = 'Actual was UNINIT'
RETURN(false)
ENDIF
IF expected=actual THEN
RETURN(true)
ELSE
error_msg = 'Expected "' + expected + '" but got "' + actual + '"'
RETURN(false)
ENDIF
END kunit_eq_str
-- Public: Assert that two XYZWPR positions are equal
--
-- expected - The expected XYZWPR value
-- actual - The actual XYZWPR value
--
-- Returns true if the X, Y, Z, W, P and R compontents are equal,
-- false otherwise
ROUTINE kunit_eq_pos(expected : XYZWPR; actual : XYZWPR) : BOOLEAN
BEGIN
assrtn_count = assrtn_count + 1
IF UNINIT(expected) OR UNINIT(actual) THEN
error_msg = 'Expected and/or actual are UNINIT'
RETURN(false)
ENDIF
IF (expected.x=actual.x) AND (expected.y=actual.y) AND (expected.z=actual.z) AND &
(expected.w=actual.w) AND (expected.p=actual.p) AND (expected.r=actual.r) THEN
RETURN(true)
ELSE
error_msg = 'Expected: ' + chr(13) &
+ p_to_s(expected) + chr(13) &
+ 'Actual: ' + chr(13) &
+ p_to_s(actual)
RETURN(false)
ENDIF
END kunit_eq_pos
-- Public: Opens the KUNIT pipe for reading and writing
--
-- This is used in conjunction with `k_close_pipe` and `kunit_pipe` to
-- test long strings are equal.
ROUTINE k_init_pipe
BEGIN
OPEN FILE pipe_f ('RW', PIPE_FILE)
END k_init_pipe
-- Public: Close the KUNIT pipe file
ROUTINE k_close_pipe
BEGIN
CLOSE FILE pipe_f
END k_close_pipe
-- Public: Write to the KUNIT pipe file
--
-- This is used in conjunction with `kunit_eq_pip` to test that the
-- value of the KUNIT pipe file is equal to the provided file
ROUTINE kunit_pipe(s : STRING)
BEGIN
WRITE pipe_f (s)
END kunit_pipe
-- Public: Assert that the KUNIT pipe is equal to the provided FILE
--
-- fname - The STRING filename of the FILE to test
--
-- Examples
--
-- kunit_eq_pipe('MD:somefile.dat')
-- # => true if the KUNIT file has the same contents of
-- 'MD:somefile.dat', false otherwise
ROUTINE kunit_eq_pip(fname : STRING) : BOOLEAN
VAR
e : STRING[64]
a : STRING[64]
i : INTEGER
k : INTEGER
j : INTEGER
status : INTEGER
b : BOOLEAN
r : BOOLEAN
BEGIN
r = true
OPEN FILE pipe_f ('RO', PIPE_FILE)
OPEN FILE other_f ('RO', fname)
BYTES_AHEAD(pipe_f, i, status)
BYTES_AHEAD(other_f, k, status)
WHILE (i > 0) AND (k > 0) DO
IF i > k THEN
j = k
ELSE
j = i
ENDIF
READ pipe_f (e::j::0)
READ other_f (a::j::0)
b = kunit_eq_str(e, a)
IF NOT(b) THEN
r = false
ENDIF
BYTES_AHEAD(pipe_f, i, status)
BYTES_AHEAD(other_f, k, status)
ENDWHILE
CLOSE FILE pipe_f
CLOSE FILE other_f
RETURN(r)
END kunit_eq_pip
-- Private: Writes the results of the KUNIT test suite
ROUTINE kunit_output
VAR
i : INTEGER
b : INTEGER
status : INTEGER
s : STRING[254]
BEGIN
GET_VAR(entry, '*system*', '$fast_clock', end_time, status)
total_time = end_time - start_time
-- make sure we do at least 1 ITP
IF total_time = 0 THEN
total_time = 2
ENDIF
OPEN FILE prog_f ('RO', PROG_PIPE)
BYTES_AHEAD(prog_F, b, status)
WHILE b > 0 DO
READ prog_f (s::b::0)
WRITE response (s)
BYTES_AHEAD(prog_F, b, status)
ENDWHILE
CLOSE FILE prog_f
WRITE response (CR,CR)
WRITE response ('Finished in ', r_to_s((total_time / 1000.0)), ' seconds', CR)
WRITE response (r_to_s(test_count/(total_time/1000.0)), ' tests/sec, ')
WRITE response (r_to_s(assrtn_count/(total_time/1000.0)), ' assertions/sec', CR, CR)
OPEN FILE fail_f ('RO', FAIL_FILE)
BYTES_AHEAD(fail_f, b, status)
WHILE b > 0 DO
READ fail_f (s::b::0)
WRITE response (s)
BYTES_AHEAD(fail_f, b, status)
ENDWHILE
CLOSE FILE fail_f
WRITE response (i_to_s(test_count), ' tests, ')
WRITE response (i_to_s(assrtn_count), ' assertions, ')
WRITE response (i_to_s(fail_count), ' failures', CR)
IF output = 'html' THEN
WRITE response ('</pre></body></html>', CR)
ENDIF
END kunit_output
ROUTINE kunit_spawn(filename : STRING)
BEGIN
RUN_TASK(filename, 0, false, false, 0, status)
IF status<>0 THEN
WRITE response ('could not spawn task ', filename, CR, 'status', status)
ELSE
task_count = task_count + 1
ENDIF
END kunit_spawn
ROUTINE kunit_clean
BEGIN
CLOSE FILE response
CLOSE FILE fail_f
CLOSE FILE prog_f
filenames = ''
output = ''
END kunit_clean
BEGIN
kunit_init
IF filenames='' THEN
WRITE response ('Please provide a list of test filenames via the GET parameter.', CR)
kunit_clean
ABORT
ENDIF
split_str(filenames, ',', filenames_a)
FOR i=1 TO 16 DO
IF NOT(UNINIT(filenames_a[i])) THEN
IF filenames_a[i]<>'' THEN
-- todo: validate filename
kunit_spawn(filenames_a[i])
ENDIF
ENDIF
ENDFOR
WHILE task_count>0 DO
PEND_SEMA(KUNIT_SEMA, MAX_WAIT, timeout)
task_count = task_count - 1
IF timeout THEN
WRITE response ('Timed out waiting for a task', CR)
ENDIF
ENDWHILE
kunit_output
kunit_clean
END kunit