18
19
20
21
22
23
24
25
26
27
28
29
30
31
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
+
|
(declare (unit tests))
(declare (uses lock-queue))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses sdb))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
|
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
-
-
+
+
|
(loop (car tal)(cdr tal))))))))))
;; Check for waiver eligibility
;;
(define (tests:check-waiver-eligibility testdat prev-testdat)
(let* ((test-registry (make-hash-table))
(testconfig (tests:get-testconfig (db:test-get-testname testdat) test-registry #f))
(test-rundir (db:test-get-rundir testdat))
(prev-rundir (db:test-get-rundir prev-testdat))
(test-rundir (sdb:qry 'getstr (db:test-get-rundir testdat)))
(prev-rundir (sdb:qry 'getstr (db:test-get-rundir prev-testdat)))
(waivers (configf:section-vars testconfig "waivers"))
(waiver-rx (regexp "^(\\S+)\\s+(.*)$"))
(diff-rule "diff %file1% %file2%")
(logpro-rule "diff %file1% %file2% | logpro %waivername%.logpro %waivername%.html"))
(if (not (file-exists? test-rundir))
(begin
(debug:print 0 "ERROR: test run directory is gone, cannot propagate waiver")
|