44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
configinfo
configdat
denoise
client-signature
remote
)
;; (define *configinfo* #f)
;; (define *configdat* #f)
;; (define *toppath* #f)
|
<
<
<
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
configinfo
configdat
denoise
client-signature
remote
)
(define *already-seen-runconfig-info* #f)
(define *waiting-queue* (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus* 0) ;; attempt to work around possible thread issues
(define *passnum* 0) ;; when running track calls to run-tests or similar
(define *write-frequency* (make-hash-table)) ;; run-id => (vector (current-seconds) 0))
(define *alt-log-file* #f) ;; used by -log
|
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
|
(let ((val (args:get-arg val)))
(if val val default)))
(define (assoc/default key lst . default)
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name)
(or (configf:lookup *configdat* "setup" "testsuite" )
(pathname-file *toppath*)))
;;======================================================================
;; E X I T H A N D L I N G
;;======================================================================
(define (std-exit-procedure)
(debug:print-info 2 "starting exit process, finalizing databases.")
(rmt:print-db-stats)
(let ((run-ids (hash-table-keys *db-local-sync*)))
(configf:lookup *configdat* "setup" "megatest-db"))
(db:multi-db-sync run-ids 'new2old)))
(if *dbstruct-db* (db:close-all *dbstruct-db*))
(if *inmemdb* (db:close-all *inmemdb*))
(if (and *megatest-db*
(sqlite3:database? *megatest-db*))
(begin
(sqlite3:interrupt! *megatest-db*)
|
|
|
|
|
|
>
|
|
|
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
|
(let ((val (args:get-arg val)))
(if val val default)))
(define (assoc/default key lst . default)
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name area-dat)
(or (configf:lookup (megatest:area-configdat area-dat) "setup" "testsuite" )
(pathname-file (megatest:area-path area-dat))))
;;======================================================================
;; E X I T H A N D L I N G
;;======================================================================
(define (std-exit-procedure area-dat)
(debug:print-info 2 "starting exit process, finalizing databases.")
(rmt:print-db-stats area-dat)
(let* ((configdat (megatest:area-configdat area-dat))
(run-ids (hash-table-keys *db-local-sync*)))
(if (and (not (null? run-ids))
(configf:lookup configdat "setup" "megatest-db"))
(db:multi-db-sync run-ids 'new2old)))
(if *dbstruct-db* (db:close-all *dbstruct-db*))
(if *inmemdb* (db:close-all *inmemdb*))
(if (and *megatest-db*
(sqlite3:database? *megatest-db*))
(begin
(sqlite3:interrupt! *megatest-db*)
|