21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
(include "common_records.scm")
;; (require-library margs)
;; (include "margs.scm")
(define getenv get-environment-variable)
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; global gletches
(define *db-keys* #f)
(define *configinfo* #f)
(define *configdat* #f)
(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
;; 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
(define *max-cache-size* 0)
(define *logged-in-clients* (make-hash-table))
(define *client-non-blocking-mode* #f)
(define *server-id* #f)
(define *server-info* #f)
(define *time-to-exit* #f)
(define *received-response* #f)
(define *default-numtries* 10)
(define *server-run* #t)
(define *db-write-access* #t)
(define *target* (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
(define *keys* (make-hash-table)) ;; cache the keys here
(define *keyvals* (make-hash-table))
(define *toptest-paths* (make-hash-table)) ;; cache toptest path settings here
(define *test-paths* (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids* (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
|
>
>
>
>
>
>
>
|
>
>
>
|
|
|
>
>
|
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
(include "common_records.scm")
;; (require-library margs)
;; (include "margs.scm")
(define getenv get-environment-variable)
(define (safe-setenv key val)
(if (and (string? val)(string? key))
(handle-exceptions
exn
(debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)
(setenv key val))
(debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)))
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; GLOBAL GLETCHES
(define *db-keys* #f)
(define *configinfo* #f)
(define *configdat* #f)
(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* 'http)
(define *megatest-db* #f)
(define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port
(define *runremote* (make-hash-table)) ;; if set up for server communication this will hold <host port>
(define *last-db-access* (current-seconds)) ;; update when db is accessed via server
(define *max-cache-size* 0)
(define *logged-in-clients* (make-hash-table))
(define *client-non-blocking-mode* #f)
(define *server-id* #f)
(define *server-info* #f)
(define *time-to-exit* #f)
(define *received-response* #f)
(define *default-numtries* 10)
(define *server-run* #t)
(define *db-write-access* #t)
(define *inmemdb* #f)
(define *run-id* #f)
(define *server-kind-run* (make-hash-table))
(define *target* (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
(define *keys* (make-hash-table)) ;; cache the keys here
(define *keyvals* (make-hash-table))
(define *toptest-paths* (make-hash-table)) ;; cache toptest path settings here
(define *test-paths* (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids* (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
|
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
(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)))
;;======================================================================
;; S T A T E S A N D S T A T U S E S
;;======================================================================
(define *common:std-states*
(list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "KILLED" "KILLREQ" "STUCK"))
(define *common:std-statuses*
(list "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP" "DELETED" "STUCK/DEAD"))
;; These are stopping conditions that prevent a test from being run
(define *common:cant-run-states-sym*
'(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE))
;;======================================================================
;; D E B U G G I N G S T U F F
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
(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")
(1 "NOT_STARTED")
(2 "RUNNING")
(3 "REMOTEHOSTSTART")
(4 "LAUNCHED")
(5 "KILLED")
(6 "KILLREQ")
(7 "STUCK")))
(define *common:std-statuses*
'((0 "PASS")
(1 "WARN")
(2 "FAIL")
(3 "CHECK")
(4 "n/a")
(5 "WAIVED")
(6 "SKIP")
(7 "DELETED")
(8 "STUCK/DEAD")))
;; These are stopping conditions that prevent a test from being run
(define *common:cant-run-states-sym*
'(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE))
;;======================================================================
;; D E B U G G I N G S T U F F
|