372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
|
(set! testdat-path (conc rundir "/testdat.db"))
0))))
(need-update (or (and (> curr-mod-time db-mod-time)
(> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched
(> (current-milliseconds)(+ last-update 10000)) ;; force update even 10 seconds
request-update))
(newtestdat (if need-update
(handle-exceptions
exn
(debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn))
(let* ((newdat (open-run-close db:get-test-info-by-id db test-id ))
(tstdat (if newdat
(open-run-close tests:testdat-get-testinfo db test-id #f)
'())))
(if (and newdat
(not (null? tstdat))) ;; (update-time cpuload diskfree run-duration)
(let* ((rec (car tstdat))
(cpuload (vector-ref rec 1))
(diskfree (vector-ref rec 2))
(run-dur (vector-ref rec 3)))
(db:test-set-run_duration! newdat run-dur)
(db:test-set-diskfree! newdat diskfree)
(db:test-set-cpuload! newdat cpuload)))
;; (debug:print 0 "newdat=" newdat)
newdat))
#f)))
;; (debug:print 0 "newtestdat=" newtestdat)
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (db:get-compressed-steps test-id work-area: rundir))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
|
>
|
>
|
>
|
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
|
(set! testdat-path (conc rundir "/testdat.db"))
0))))
(need-update (or (and (> curr-mod-time db-mod-time)
(> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched
(> (current-milliseconds)(+ last-update 10000)) ;; force update even 10 seconds
request-update))
(newtestdat (if need-update
;; NOTE: BUG HIDER, try to eliminate this exception handler
(handle-exceptions
exn
(debug:print-info 0 "WARNING: test db access issue for test " test-id ": " ((condition-property-accessor 'exn 'message) exn))
(make-db:test)
(let* ((newdat (open-run-close db:get-test-info-by-id db test-id ))
(tstdat (if newdat
(open-run-close tests:testdat-get-testinfo db test-id #f)
'())))
(if (and newdat
(not (null? tstdat))) ;; (update-time cpuload diskfree run-duration)
(let* ((rec (car tstdat))
(cpuload (vector-ref rec 1))
(diskfree (vector-ref rec 2))
(run-dur (vector-ref rec 3)))
(db:test-set-run_duration! newdat run-dur)
(db:test-set-diskfree! newdat diskfree)
(db:test-set-cpuload! newdat cpuload)))
;; (debug:print 0 "newdat=" newdat)
newdat)
)
#f)))
;; (debug:print 0 "newtestdat=" newtestdat)
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (db:get-compressed-steps test-id work-area: rundir))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
|