Overview
Context
Changes
Modified api-inc.scm
from [b1f7138e4f]
to [cf65f4ddef].
︙ | | |
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
-
+
|
((no-sync-del!) (apply db:no-sync-del! *no-sync-db* params))
((no-sync-get-lock) (apply db:no-sync-get-lock *no-sync-db* params))
;; ARCHIVES
;; ((archive-get-allocations)
((archive-register-disk) (apply db:archive-register-disk dbstruct params))
((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
;; ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
;;======================================================================
;; READ ONLY QUERIES
;;======================================================================
;; KEYS
((get-key-val-pairs) (apply db:get-key-val-pairs dbstruct params))
|
︙ | | |
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
-
+
|
((test-toplevel-num-items) (apply db:test-toplevel-num-items dbstruct params))
((get-test-info-by-id) (apply db:get-test-info-by-id dbstruct params))
((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id dbstruct params))
((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params))
((get-count-tests-running) (apply db:get-count-tests-running dbstruct params))
((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
;; ((delete-test-step-records) (apply db:delete-test-step-records dbstruct params))
((get-previous-test-run-record) (apply db:get-previous-test-run-record dbstruct params))
;; ((get-previous-test-run-record) (apply db:get-previous-test-run-record dbstruct params))
((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
((test-get-logfile-info) (apply db:test-get-logfile-info dbstruct params))
((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params))
((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params))
((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params))
((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params))
|
︙ | | |
Modified client-inc.scm
from [7d18e90e50]
to [3380248605].
︙ | | |
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
-
-
+
+
|
;; Not currently used! But, I think it *should* be used!!!
#;(define (client:logout serverdat)
(let ((ok (and (socket? serverdat)
(cdb:logout serverdat *toppath* (client:get-signature)))))
ok))
(define (client:connect iface port)
(http:client-connect iface port)
#;(define (client:connect iface port)
(http-transport:client-connect iface port)
#;(case (server:get-transport)
((rpc) (rpc:client-connect iface port))
((http) (http:client-connect iface port))
((zmq) (zmq:client-connect iface port))
(else (rpc:client-connect iface port))))
(define (client:setup areapath #!key (remaining-tries 100) (failed-connects 0))
|
︙ | | |
Modified common-inc.scm
from [5d1061a2f1]
to [243b419338].
︙ | | |
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
|
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
|
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
+
|
;; (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f))
(testpatt-key (or (args:get-arg "-modepatt") (args:get-arg "--modepatt") "TESTPATT"))
(args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%"))
(rtestpatt (if rconf (runconfigs-get rconf testpatt-key) #f)))
(cond
((or (args:get-arg "--modepatt") (args:get-arg "-modepatt")) ;; modepatt is a forced setting, when set it MUST refer to an existing PATT in the runconfig
(if rconf
(let* ((patts-from-mode-patt (runconfigs-get rconf testpatt-key)))
(debug:print-info 0 *default-log-port* "modepatt defined is: "testpatt-key" runconfigs values for " testpatt-key " " patts-from-mode-patt)
patts-from-mode-patt)
(begin
(debug:print-info 0 *default-log-port* " modepatt defined is: "testpatt-key" runconfigs values for " testpatt-key " " patts-from-mode-patt)
#f))) ;; We do NOT fall back to "%"
(let* ((patts-from-mode-patt (runconfigs-get rconf testpatt-key)))
(debug:print-info 0 *default-log-port* "modepatt defined is: "testpatt-key" runconfigs values for " testpatt-key " " patts-from-mode-patt)
patts-from-mode-patt)
(begin
(debug:print-info 0 *default-log-port* " modepatt defined is: "testpatt-key" runconfigs values for " testpatt-key) ;; " " patts-from-mode-patt)
#f))) ;; We do NOT fall back to "%"
;; (tags-testpatt
;; (debug:print-info 0 *default-log-port* "-tagexpr "tagexpr" selects testpatt "tags-testpatt)
;; tags-testpatt)
((and (equal? args-testpatt "%") rtestpatt)
(debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
rtestpatt)
(else
(debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
args-testpatt))))
(debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
args-testpatt))))
(define (common:false-on-exception thunk #!key (message #f))
(handle-exceptions exn
(begin
(if message
|
︙ | | |
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
|
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
|
-
+
|
;;======================================================================
;; NMSG AND NEW API
;;======================================================================
;; nm based server experiment, keep around for now.
;;
(define (nm:start-server dbconn #!key (given-host-name #f))
#;(define (nm:start-server dbconn #!key (given-host-name #f))
(let* ((srvdat (start-raw-server given-host-name: given-host-name))
(host-name (srvdat-host srvdat))
(soc (srvdat-soc srvdat)))
;; start the queue processor (save for second round of development)
;;
(thread-start! (make-thread! (lambda ()(queue-processor dbconn) "Queue processor")))
|
︙ | | |
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
|
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
|
-
-
|
host-port: host-port
params: params)))
(queue-push cmddat) ;; put request into the queue
(nn-send soc "queued")) ;; reply with "queued"
(print "ERROR: ["(common:human-time)"] BAD request " dat))
(loop (nn-recv soc)))))
(nn-close soc)))
;;======================================================================
;; D A S H B O A R D U S E R V I E W S
;;======================================================================
;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
|
︙ | | |
Modified configf-inc.scm
from [94db5b94fc]
to [3be5b29d7f].
︙ | | |
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
|
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
|
-
+
|
(let ((val (config-lookup refdat section var)))
(if (not val) ;; this one is new
(begin
(if (null? sdat)(set! sdat (list (conc "[" section "]"))))
(set! sdat (append sdat (list (conc var " " val))))))))
svars)
(set! fdat (append fdat sdat))))
(delete-duplicates (append require-sections (hash-table-keys indat))))
(delete-duplicates (append required-sections (hash-table-keys indat))))
;; step 5: Write out new file
(with-output-to-file fname
(lambda ()
(for-each
(lambda (line)
(print line))
|
︙ | | |
Added dashboard-tests-inc.scm version [870d62fcf3].