398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
|
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
|
-
+
|
(pathname-file *toppath*)
(pathname-file (current-directory)))))
(define (common:get-db-tmp-area)
(if *db-cache-path*
*db-cache-path*
(let ((dbpath (create-directory (conc "/tmp/" (current-user-name)
"/megatest_cachedb/"
"/megatest_localdb/"
(common:get-testsuite-name) "/"
(string-translate *toppath* "/" ".")) #t)))
(set! *db-cache-path* dbpath)
dbpath)))
(define (common:get-area-path-signature)
(message-digest-string (md5-primitive) *toppath*))
|
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
|
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
|
-
-
-
-
-
+
+
+
+
+
+
+
|
(begin
(set! *time-to-exit* #t)
#t))))
(debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.")
(if (and no-hurry (debug:debug-mode 18))
(rmt:print-db-stats))
(let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
(let ((run-ids (hash-table-keys *db-local-sync*)))
(if (and (not (null? run-ids))
(or (common:legacy-sync-recommended)
(configf:lookup *configdat* "setup" "megatest-db")))
(if no-hurry (db:multi-db-sync run-ids 'new2old))))
;; (let ((run-ids (hash-table-keys *db-local-sync*)))
;; (if (and (not (null? run-ids))
;; (or (common:legacy-sync-recommended)
;; (configf:lookup *configdat* "setup" "megatest-db")))
;; (if no-hurry
;; (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*)
(sqlite3:finalize! *megatest-db* #t)
|