Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -297,11 +297,11 @@ (last-update 0) ;; (current-seconds)) (request-update #t) (db #f)) (if (not testdat) (begin - (debug:print 0 "ERROR: No test data found for test " test-id ", exiting") + (debug:print 2 "ERROR: No test data found for test " test-id ", exiting") (exit 1)) (let* ((run-id (if testdat (db:test-get-run_id testdat) #f)) (keydat (if testdat (open-run-close db:get-key-val-pairs #f run-id) #f)) (rundat (if testdat (open-run-close db:get-run-info #f run-id) #f)) (runname (if testdat (db:get-value-by-header (db:get-row rundat) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1105,11 +1105,11 @@ (define (cdb:tests-update-run-duration serverdat test-id minutes) (cdb:client-call serverdat 'update-run-duration #t *default-numtries* minutes test-id)) (define (cdb:tests-update-uname-host serverdat test-id uname hostname) - (cdb:client-call serverdat 'update-uname-host #t *default-numtries* test-id uname hostname)) + (cdb:client-call serverdat 'update-uname-host #t *default-numtries* uname hostname test-id)) ;; speed up for common cases with a little logic (define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment) (cond ((and newstate newstatus newcomment) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -135,11 +135,11 @@ (alist->env-vars env-ovrd) (set-megatest-env-vars run-id) (set-item-env-vars itemdat) (save-environment-as-files "megatest") ;; open-run-close not needed for test-set-meta-info - (tests:set-meta-info #f test-id run-id test-name itemdat 0 work-area) + (tests:set-full-meta-info #f test-id run-id 0 work-area) (tests:test-set-status! test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f) (if (args:get-arg "-xterm") (set! fullrunscript "xterm") (if (and fullrunscript (not (file-execute-access? fullrunscript))) (system (conc "chmod ug+x " fullrunscript)))) @@ -170,11 +170,11 @@ (vector-set! exit-info 2 exit-code) (set! rollup-status exit-code) (mutex-unlock! m) (if (eq? pid-val 0) (begin - (thread-sleep! 2) + (thread-sleep! 1) (loop (+ i 1))) ))))) ;; then, if runscript ran ok (or did not get called) ;; do all the ezsteps (if any) (if ezsteps @@ -223,11 +223,11 @@ (vector-set! exit-info 1 exit-status) (vector-set! exit-info 2 exit-code) (mutex-unlock! m) (if (eq? pid-val 0) (begin - (thread-sleep! 2) + (thread-sleep! 1) (processloop (+ i 1)))) )) (let ((exinfo (vector-ref exit-info 2)) (logfna (if logpro-used (conc stepname ".html") ""))) ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect) @@ -275,10 +275,11 @@ (round (- (current-seconds) start-seconds))))) (kill-tries 0)) + (tests:set-full-meta-info #f test-id run-id (calc-minutes) work-area) (let loop ((minutes (calc-minutes))) (begin (set! kill-job? (or (test-get-kill-request test-id) ;; run-id test-name itemdat)) (and runtlim (let* ((run-seconds (- (current-seconds) start-seconds)) (time-exceeded (> run-seconds runtlim))) @@ -286,11 +287,11 @@ (begin (debug:print-info 0 "KILLING TEST DUE TO TIME LIMIT EXCEEDED! Runtime=" run-seconds " seconds, limit=" runtlim) #t) #f))))) ;; open-run-close not needed for test-set-meta-info - (tests:set-meta-info #f test-id run-id test-name itemdat minutes work-area) + (tests:set-partial-meta-info #f test-id run-id minutes work-area) (if kill-job? (begin (mutex-lock! m) ;; NOTE: The pid can change as different steps are run. Do we need handshaking between this ;; section and the runit section? Or add a loop that tries three times with a 1/4 second Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -679,42 +679,43 @@ tdb "SELECT count(id) FROM test_rundat;") res)) 0) -(define (tests:update-central-meta-info test-id cpuload diskfree minutes num-records uname hostname) +(define (tests:update-central-meta-info test-id cpuload diskfree minutes uname hostname) ;; This is a good candidate for threading the requests to enable ;; transactionized write at the server (cdb:tests-update-cpuload-diskfree *runremote* test-id cpuload diskfree) - ;; (let ((db (open-db))) - ;; (sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;" - ;; cpuload - ;; diskfree - ;; test-id) - (if minutes - (cdb:tests-update-run-duration *runremote* test-id minutes)) - ;; (sqlite3:execute db "UPDATE tests SET run_duration=? WHERE id=?;" minutes test-id)) - (if (eq? num-records 0) - (cdb:tests-update-uname-host *runremote* test-id uname hostname)) - ;;(sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE id=?;" uname hostname test-id)) - ;;(sqlite3:finalize! db)) - ) - -(define (tests:set-meta-info db test-id run-id testname itemdat minutes work-area) + (if minutes + (cdb:tests-update-run-duration *runremote* test-id minutes)) + (if (and uname hostname) + (cdb:tests-update-uname-host *runremote* test-id uname hostname))) + +(define (tests:set-full-meta-info db test-id run-id minutes work-area) + ;; DOES cdb:remote-run under the hood! + (let* ((num-records 0) ;; (test:tdb-get-rundat-count tdb)) + (cpuload (get-cpu-load)) + (diskfree (get-df (current-directory))) + (uname (get-uname "-srvpio")) + (hostname (get-host-name))) + (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes) + (tests:update-central-meta-info test-id cpuload diskfree minutes uname hostname))) + +(define (tests:set-partial-meta-info db test-id run-id minutes work-area) ;; DOES cdb:remote-run under the hood! - (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)) - (num-records (test:tdb-get-rundat-count tdb)) - (cpuload (get-cpu-load)) + (let* ((cpuload (get-cpu-load)) (diskfree (get-df (current-directory)))) - (if (eq? (modulo num-records 10) 0) ;; every ten records update central - (let ((uname (get-uname "-srvpio")) - (hostname (get-host-name))) - (tests:update-central-meta-info test-id cpuload diskfree minutes num-records uname hostname))) + (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes) + ;; Update central with uname and hostname = #f + (tests:update-central-meta-info test-id cpuload diskfree minutes #f #f))) + +(define (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes) + (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))) (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);" cpuload diskfree minutes) (sqlite3:finalize! tdb))) - + ;;====================================================================== ;; A R C H I V I N G ;;====================================================================== (define (test:archive db test-id)