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
80
81
82
83
84
85
86
|
(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 *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
(define *test-info* (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db
;; Awful. Please FIXME
(define *env-vars-by-run-id* (make-hash-table))
(define *current-run-name* #f)
(define (common:clear-caches)
(set! *target* (make-hash-table))
(set! *keys* (make-hash-table))
(set! *keyvals* (make-hash-table))
(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! *env-vars-by-run-id* (make-hash-table))
(set! *test-id-cache* (make-hash-table)))
;; Debugging stuff
(define *verbosity* 1)
(define *logging* #f)
|
>
>
>
>
>
|
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
80
81
82
83
84
85
86
87
88
89
90
91
|
(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
(define *test-info* (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db
(define *run-info-cache* (make-hash-table)) ;; run info is stable, no need to reget
;; Awful. Please FIXME
(define *env-vars-by-run-id* (make-hash-table))
(define *current-run-name* #f)
(define (common:clear-caches)
(set! *target* (make-hash-table))
(set! *keys* (make-hash-table))
(set! *keyvals* (make-hash-table))
(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)))
;; Debugging stuff
(define *verbosity* 1)
(define *logging* #f)
|
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
#f #t))) string<?))
;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
(define (common:get-disks)
(hash-table-ref/default
(read-config "megatest.config" #f #t)
"disks" '("none" "")))
;;======================================================================
;; System stuff
;;======================================================================
;; return a nice clean pathname made absolute
(define (nice-path dir)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
#f #t))) string<?))
;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
(define (common:get-disks)
(hash-table-ref/default
(read-config "megatest.config" #f #t)
"disks" '("none" "")))
;;======================================================================
;; M I S C L I S T S
;;======================================================================
;; items in lista are matched value and position in listb
;; return the remaining items in listb or #f
;;
(define (common:list-is-sublist lista listb)
(if (null? lista)
listb ;; all items in listb are "remaining"
(if (> (length lista)(length listb))
#f
(let loop ((heda (car lista))
(tala (cdr lista))
(hedb (car listb))
(talb (cdr listb)))
(if (equal? heda hedb)
(if (null? tala) ;; we are done
talb
(loop (car tala)
(cdr tala)
(car talb)
(cdr talb)))
#f)))))
;;======================================================================
;; System stuff
;;======================================================================
;; return a nice clean pathname made absolute
(define (nice-path dir)
|