482
483
484
485
486
487
488
489
490
491
492
493
494
495
|
;; select end_time-now from
;; (select testname,item_path,event_time+run_duration as
;; end_time,strftime('%s','now') as now from tests where state in
;; ('RUNNING','REMOTEHOSTSTART','LAUNCED'));
(define (db:find-and-mark-incomplete db #!key (ovr-deadtime #f))
(let* ((incompleted '())
(toplevels '())
(deadtime-str (configf:lookup *configdat* "setup" "deadtime"))
(deadtime (if (and deadtime-str
(string->number deadtime-str))
(string->number deadtime-str)
7200)) ;; two hours
(run-ids (db:get-run-ids db))) ;; iterate over runs to divy up the calls
|
>
|
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
|
;; select end_time-now from
;; (select testname,item_path,event_time+run_duration as
;; end_time,strftime('%s','now') as now from tests where state in
;; ('RUNNING','REMOTEHOSTSTART','LAUNCED'));
(define (db:find-and-mark-incomplete db #!key (ovr-deadtime #f))
(let* ((incompleted '())
(oldlaunched '())
(toplevels '())
(deadtime-str (configf:lookup *configdat* "setup" "deadtime"))
(deadtime (if (and deadtime-str
(string->number deadtime-str))
(string->number deadtime-str)
7200)) ;; two hours
(run-ids (db:get-run-ids db))) ;; iterate over runs to divy up the calls
|
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
|
run-id)
;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
;;
(db:delay-if-busy)
(sqlite3:for-each-row
(lambda (test-id run-dir uname testname item-path)
(set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted)))
db
"SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');"
run-id))
run-ids)
;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
;;
(db:delay-if-busy)
(let* ((min-incompleted (filter (lambda (x)
(let* ((testpath (cadr x))
(tdatpath (conc testpath "/testdat.db"))
(dbexists (file-exists? tdatpath)))
(or (not dbexists) ;; if no file then something wrong - mark as incomplete
(> (- (current-seconds)(file-modification-time tdatpath)) 600)))) ;; no change in 10 minutes to testdat.db - she's dead Jim
incompleted))
(min-incompleted-ids (map car min-incompleted)))
(if (> (length min-incompleted-ids) 0)
(begin
(debug:print 0 "WARNING: Marking test(s); " (string-intersperse (map conc min-incompleted-ids) ", ") " as INCOMPLETE")
(sqlite3:execute
db
(conc "UPDATE tests SET state='INCOMPLETE' WHERE id IN ("
(string-intersperse (map conc min-incompleted-ids) ",")
");")))))
;; Now do rollups for the toplevel tests
;;
(for-each
(lambda (toptest)
(let ((test-name (list-ref toptest 3))
|
>
>
>
|
>
|
>
|
|
|
|
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
|
run-id)
;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
;;
(db:delay-if-busy)
(sqlite3:for-each-row
(lambda (test-id run-dir uname testname item-path)
(if (and (equal? uname "n/a")
(equal? item-path "")) ;; this is a toplevel test
;; what to do with toplevel? call rollup?
(set! toplevels (cons (list test-id run-dir uname testname item-path run-id) toplevels))
(set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched))))
db
"SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');"
run-id))
run-ids)
;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
;;
(db:delay-if-busy)
(let* ((min-incompleted (filter (lambda (x)
(let* ((testpath (cadr x))
(tdatpath (conc testpath "/testdat.db"))
(dbexists (file-exists? tdatpath)))
(or (not dbexists) ;; if no file then something wrong - mark as incomplete
(> (- (current-seconds)(file-modification-time tdatpath)) 600)))) ;; no change in 10 minutes to testdat.db - she's dead Jim
incompleted))
(min-incompleted-ids (map car min-incompleted))
(all-ids (append min-incompleted-ids (map car oldlaunched))))
(if (> (length all-ids) 0)
(begin
(debug:print 0 "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE")
(sqlite3:execute
db
(conc "UPDATE tests SET state='INCOMPLETE' WHERE id IN ("
(string-intersperse (map conc all-ids) ",")
");")))))
;; Now do rollups for the toplevel tests
;;
(for-each
(lambda (toptest)
(let ((test-name (list-ref toptest 3))
|