Overview
Context
Changes
Modified common_records.scm
from [676b1d8a73]
to [9ac4a598ab].
︙ | | |
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
-
-
+
+
|
(apply print params)
(if *logging* (apply db:log-event params))))))
(define (debug:print-info n . params)
(if (debug:debug-mode n)
(with-output-to-port (current-error-port)
(lambda ()
(let ((res (format#format #f "INFO:~2d ~a" n (apply conc params))))
(print res)
(let ((res #f));; (format#format #f "INFO:~2d ~a" n (apply conc params))))
(apply print "INFO: (" n ") " params) ;; res)
(if *logging* (db:log-event res)))))))
;; if a value is printable (i.e. string or number) return the value
;; else return an empty string
(define-inline (printable val)
(if (or (number? val)(string? val)) val ""))
|
Modified db.scm
from [bee7518912]
to [f9d64d5f5d].
︙ | | |
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
-
+
|
(if (not dbexists)
(db:initialize db))
(db:set-sync db)
db))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START, idb=" idb ", params=" params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(let* ((db (if idb idb (open-db)))
(res #f))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res))
|
︙ | | |
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
|
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
|
-
-
-
+
|
(define (db:obj->string obj)(with-output-to-string (lambda ()(serialize obj))))
(define (db:string->obj msg)(with-input-from-string msg (lambda ()(deserialize))))
(define (cdb:client-call zmq-socket . params)
(debug:print-info 11 "cdb:client-call zmq-socket=" zmq-socket " params=" params)
(let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f))
(print "cdb:client-call before send message, params=" params)
(send-message zmq-socket zdat)
(print "cdb:client-call after send message")
(set! res (db:string->obj (receive-message zmq-socket zdat)))
(debug:print-info 11 "zmq-socket " (car params) " res=" res)
res))
(define (cdb:test-set-status-state zmqsocket test-id status state msg)
(if msg
(cdb:client-call zmqsocket 'state-status-msg #t state status msg test-id)
(cdb:client-call zmqsocket 'state-status #t state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree)
(define (cdb:test-rollup-test_data-pass-fail zmqsocket test-id)
(cdb:client-call zmqsocket 'test_data-pf-rollup #t test-id test-id test-id))
(cdb:client-call zmqsocket 'test_data-pf-rollup #t test-id test-id test-id test-id))
(define (cdb:pass-fail-counts zmqsocket test-id fail-count pass-count)
(cdb:client-call zmqsocket 'pass-fail-counts #t fail-count pass-count test-id))
(define (cdb:tests-register-test zmqsocket run-id test-name item-path)
(let ((item-paths (if (equal? item-path "")
(list item-path)
|
︙ | | |
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
|
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
|
-
+
-
+
|
tdb
"SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count,
(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;"
test-id test-id)
(sqlite3:finalize! tdb)
;; Now rollup the counts to the central megatest.db
(cdb:pass-fail-counts *remoterun* test-id fail-count pass-count)
(cdb:pass-fail-counts *runremote* test-id fail-count pass-count)
;; (sqlite3:execute db "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;"
;; fail-count pass-count test-id)
(thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least 10ms later than the set
;; if the test is not FAIL then set status based on the fail and pass counts.
(cdb:test-rollup-test_data-pass-fail *remoterun* test-id)
(cdb:test-rollup-test_data-pass-fail *runremote* test-id)
;; (sqlite3:execute
;; db ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME
;; "UPDATE tests
;; SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0
;; THEN 'FAIL'
;; WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND
;; (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL')
|
︙ | | |
Modified server.scm
from [8eaeed198f]
to [3324d285ea].
︙ | | |
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
-
+
-
-
+
+
+
|
(include "db_records.scm")
(define (server:run hostn)
(debug:print 0 "Attempting to start the server ...")
(let ((host:port (open-run-close db:get-var #f "SERVER"))) ;; do whe already have a server running?
(if host:port
(begin
(debug:print 0 "ERROR: server already running.")
(debug:print 0 "WARNING: server already running.")
(if (server:client-setup)
(begin
(debug:print-info 0 "Server is alive, exiting")
(exit))
(debug:print-info 0 "Server is alive, not starting another")
;;(exit)
)
(begin
(debug:print-info 0 "Server is dead, removing flag and trying again")
(open-run-close db:del-var #f "SERVER")
(server:run hostn))))
(let* ((zmq-socket #f)
(hostname (if (string=? "-" hostn)
(get-host-name)
|
︙ | | |