36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
+
+
+
|
(define *toppath* #f)
(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
;; DATABASE
(define *open-dbs* (vector #f (make-hash-table))) ;; megatestdb run-id-dbs
;; SERVER
(define *my-client-signature* #f)
(define *transport-type* 'fs)
(define *megatest-db* #f)
(define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port
(define *runremote* #f) ;; if set up for server communication this will hold <host port>
(define *last-db-access* (current-seconds)) ;; update when db is accessed via server
|
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
+
+
+
+
+
|
(set! *toptest-paths* (make-hash-table))
(set! *test-paths* (make-hash-table))
(set! *test-ids* (make-hash-table))
(set! *test-info* (make-hash-table))
(set! *run-info-cache* (make-hash-table))
(set! *env-vars-by-run-id* (make-hash-table))
(set! *test-id-cache* (make-hash-table)))
;; Generic string database (normalization of sorts)
(define sdb:qry #f) ;; (make-sdb:qry)) ;; 'init #f)
;; Generic path database (normalization of sorts)
(define *fdb* #f)
;;======================================================================
;; S T A T E S A N D S T A T U S E S
;;======================================================================
(define *common:std-states*
'((0 "COMPLETED")
|
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
|
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
|
-
+
|
(uname #f))
(if (null? (car uname-res))
"unknown"
(caar uname-res))))
(define (save-environment-as-files fname #!key (ignorevars (list "DISPLAY" "LS_COLORS" "XKEYSYMDB" "EDITOR")))
(let ((envvars (get-environment-variables))
(whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]")))
(whitesp (regexp "[^a-zA-Z0-9_\\-:,.\\/%$]")))
(with-output-to-file (conc fname ".csh")
(lambda ()
(for-each (lambda (key)
(if (not (member key ignorevars))
(let* ((val (cdr key))
(sval (if (string-search whitesp val)(conc "\"" val "\"") val)))
(print "setenv " (car key) " " sval))))
|