(if (string? res)
(let ((valnum (string->number res)))
(if valnum valnum res))
res)))
(define (db:set-var db var val)
(sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val))
;; use a global for some primitive caching, it is just silly to re-read the db
;; over and over again for the keys since they never change
(define *db-keys* #f)
(define (db-get-keys db)
(if *db-keys* *db-keys*
(let ((res '()))
(sqlite3:for-each-row
(lambda (key keytype)
(set! res (cons (vector key keytype) res)))
db
"SELECT fieldname,fieldtype FROM keys ORDER BY id DESC;")
res))
(let ((res '()))
(sqlite3:for-each-row
(lambda (key keytype)
(set! res (cons (vector key keytype) res)))
db
"SELECT fieldname,fieldtype FROM keys ORDER BY id DESC;")
(set! *db-keys* res)
res)))
(define db:get-keys db-get-keys)
(define-inline (db:get-header vec)(vector-ref vec 0))
(define-inline (db:get-rows vec)(vector-ref vec 1))
(define (db:get-value-by-header row header field)
(if (null? header) #f
(let loop ((hed (car header))
run-id
test-name
pth
;; (conc "," (string-intersperse tags ",") ",")
))
item-paths )))
;; get the previous record for when this test was run where all keys match but runname
;; (define db (open-db))
;; (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer")(define (test:get-previous-test-run-records db run-id test-name item-path)
(let* ((keys (db:get-keys db))
(selstr (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
(qrystr (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
(keyvals #f))
;; first look up the key values from the run selected by run-id
(sqlite3:for-each-row
(lambda (a . b)
(set! keyvals (cons a b)))
db
(conc "SELECT " selstr " FROM runs WHERE run_id=? ORDER BY event_time DESC;"))
(if (not keyvals)
#f
(let ((prev-run-ids '()))
(apply sqlite3:for-each-row
(lambda (id)
(set! prev-run-ids (cons id prev-run-ids)))
db
(conc "SELECT run_id FROM runs WHERE " qrystr ";"))
;; for each run starting with the most recent look to see if there is a matching test
;; if found then return that matching test record
(if (null? prev-run-ids) #f
(let loop ((hed (car prev-run-ids))
(tal (cdr prev-run-ids)))
(let ((results (db-get-tests-for-run db test-name item-path)))
(if (and (null? results)
(not (null? tal)))
(loop (car tal)(cdr tal))
(car results)))))))))
(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
(let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
(otherdat (if dat dat (make-hash-table)))) (otherdat (if dat dat (make-hash-table)))
;; before proceeding we must find out if the previous test (where all keys matched except runname)
;; was WAIVED if this test is FAIL
(waived (if (equal? status "FAIL")
(let ((prev-test (test:get-previous-test-run-records db run-id test-name item-path)))
(if (and prev-test (not (null? prev-test))) ;; true if we found a previous test in this run series
(let ((prev-status (db:test-get-status prev-test))
(prev-state (db:test-get-state prev-test))
(prev-comment (db:test-get-comment prev-test)))
(if (and (equal? prev-status "COMPLETED")
(equal? prev-state "WAIVED"))
prev-comment ;; waived is either the comment or #f
#f))
#f))
#f)))
;; update the primary record IF state AND status are defined
(if (and state status)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
state status run-id test-name item-path))
;; add metadata (need to do this way to avoid SQL injection issues)
;; :value
(let ((val (hash-table-ref/default otherdat ":value" #f)))
(debug:print 1 "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it."))
((LAUNCHED REMOTEHOSTSTART RUNNING)
(if (> (- (current-seconds)(+ (db:test-get-event_time testdat)
(db:test-get-run_duration testdat)))
100) ;; i.e. no update for more than 100 seconds
(begin
(debug:print 0 "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD")
(test-set-status! db run-id test-name "INCOMPLETE" "STUCK/DEAD" itemdat "Test is stuck or dead"))
(test-set-status! db run-id test-name "INCOMPLETE" "STUCK/DEAD" itemdat "Test is stuck or dead" #f))
(debug:print 2 "NOTE: " test-name " is already running")))
(else (debug:print 0 "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state testdat))))))
(if (not (null? tal))
(loop (car tal)(cdr tal)))))))))
(define (run-waiting-tests db)
(let ((numtries 0)