94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
+
|
(define *megatest-db* #f)
(define *last-db-access* (current-seconds)) ;; update when db is accessed via server
(define *db-write-access* #t)
(define *inmemdb* #f)
(define *task-db* #f) ;; (vector db path-to-db)
(define *db-access-allowed* #t) ;; flag to allow access
(define *db-access-mutex* (make-mutex))
(define *db-cache-path* #f)
;; SERVER
(define *my-client-signature* #f)
(define *transport-type* 'http)
(define *transport-type* 'http) ;; override with [server] transport http|rpc|nmsg
(define *runremote* (make-hash-table)) ;; if set up for server communication this will hold <host port>
(define *max-cache-size* 0)
|
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
|
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
+
+
-
-
-
-
+
+
+
+
+
+
|
(define (common:get-testsuite-name)
(or (configf:lookup *configdat* "setup" "testsuite" )
(if *toppath*
(pathname-file *toppath*)
(pathname-file (current-directory)))))
(define (common:get-db-tmp-area)
(if *db-cache-path*
*db-cache-path*
(create-directory (conc "/tmp/" (current-user-name)
"/megatest/"
(common:get-testsuite-name) "/"
(string-translate *toppath* "/" "_")) #t))
(let ((dbpath (create-directory (conc "/tmp/" (current-user-name)
"/megatest_cachedb/"
(common:get-testsuite-name) "/"
(string-translate *toppath* "/" ".")) #t)))
(set! *db-cache-path* dbpath)
dbpath)))
;;======================================================================
;; E X I T H A N D L I N G
;;======================================================================
(define (common:legacy-sync-recommended)
(or (args:get-arg "-runtests")
|