Overview
Comment: | More adjustments to inmem |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
7c12fbc39a2545c4d3bf4523be4e0e47 |
User & Date: | matt on 2013-11-12 21:49:17 |
Other Links: | manifest | tags |
Context
2013-11-12
| ||
23:26 | 90% done with migration to inmem db check-in: 6b749d9f51 user: matt tags: trunk | |
21:49 | More adjustments to inmem check-in: 7c12fbc39a user: matt tags: trunk | |
21:12 | More ported to inmem check-in: 662f6304a0 user: matt tags: trunk | |
Changes
Modified api.scm from [41b5b06e44] to [306fb2ca21].
︙ | ︙ | |||
44 45 46 47 48 49 50 | ((get-prereqs-not-met) (let ((res (apply db:get-prereqs-not-met db params))) (map (lambda (x) (if (vector? x) (vector->list x) x)) res))) ((roll-up-pass-fail-counts) (apply db:roll-up-pass-fail-counts db params)) | | | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | ((get-prereqs-not-met) (let ((res (apply db:get-prereqs-not-met db params))) (map (lambda (x) (if (vector? x) (vector->list x) x)) res))) ((roll-up-pass-fail-counts) (apply db:roll-up-pass-fail-counts db params)) ((update-fail-pass-counts) (apply db:general-call db 'update-pass-fail-counts params)) ;; RUNS ((get-run-info) (let ((res (apply db:get-run-info db params))) (list (vector-ref res 0) (vector->list (vector-ref res 1))))) ((register-run) (apply db:register-run db params)) ((set-tests-state-status) (apply db:set-tests-state-status db params)) |
︙ | ︙ |
Modified db.scm from [32892c2413] to [3ae86045c1].
︙ | ︙ | |||
1631 1632 1633 1634 1635 1636 1637 | ;; (if (or *db-write-access* ;; (not (member proc *db:all-write-procs*))) ;; (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params) ;; (begin ;; (debug:print 0 "ERROR: Attempt to access read-only database") ;; #f))) | | | 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 | ;; (if (or *db-write-access* ;; (not (member proc *db:all-write-procs*))) ;; (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params) ;; (begin ;; (debug:print 0 "ERROR: Attempt to access read-only database") ;; #f))) (define (db:roll-up-pass-fail-counts db run-id test-name item-path status) (if (and (not (equal? item-path "")) (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP"))) (begin (db:general-call 'update-pass-fail-counts db (list run-id test-name run-id test-name)) (if (equal? status "RUNNING") (db:general-call 'top-test-set-running db (list run-id test-name)) (db:general-call 'top-test-set-per-pf-counts db (list run-id test-name run-id test-name))) |
︙ | ︙ | |||
1691 1692 1693 1694 1695 1696 1697 | '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") '(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") '(update-run-duration "UPDATE tests SET run_duration=? WHERE id=?;") '(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;") '(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") '(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") ;; stuff for roll-up-pass-fail-counts | | | 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 | '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") '(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") '(update-run-duration "UPDATE tests SET run_duration=? WHERE id=?;") '(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;") '(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") '(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") ;; stuff for roll-up-pass-fail-counts '(update-pass-fail-counts "UPDATE tests SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')), pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED')) WHERE run_id=? AND testname=? AND item_path='';") '(top-test-set-running "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';") '(top-test-set-per-pf-counts "UPDATE tests SET state=CASE WHEN (SELECT count(id) FROM tests |
︙ | ︙ |
Modified rmt.scm from [00b9d433cf] to [59b3151e52].
︙ | ︙ | |||
38 39 40 41 42 43 44 | (if res (rmt:json-str->dat res) (begin (debug:print 0 "ERROR: Bad value from http-transport:client-api-send-receive " res) #f)) )) (else | | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | (if res (rmt:json-str->dat res) (begin (debug:print 0 "ERROR: Bad value from http-transport:client-api-send-receive " res) #f)) )) (else (debug:print 0 "ERROR: Transport " *transport-type* " not yet (re)supported") (exit 1)))) ;; Wrap json library for strings (why the ports crap in the first place?) (define (rmt:dat->json-str dat) (with-output-to-string (lambda () (json-write dat)))) |
︙ | ︙ | |||
170 171 172 173 174 175 176 | (define (rmt:get-count-tests-running) (rmt:send-receive 'get-count-tests-running '())) (define (rmt:get-count-tests-running-in-jobgroup jobgroup) (rmt:send-receive 'get-count-tests-running-in-jobgroup (list jobgroup))) (define (rmt:roll-up-pass-fail-counts run-id test-name item-path status) | < < < | < < < < < | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | (define (rmt:get-count-tests-running) (rmt:send-receive 'get-count-tests-running '())) (define (rmt:get-count-tests-running-in-jobgroup jobgroup) (rmt:send-receive 'get-count-tests-running-in-jobgroup (list jobgroup))) (define (rmt:roll-up-pass-fail-counts run-id test-name item-path status) (rmt:send-receive 'roll-up-pass-fail-counts (list run-id test-name item-path status))) (define (rmt:update-pass-fail-counts run-id test-name) (rmt:general-call 'update-fail-pass-counts run-id test-name run-id test-name run-id test-name)) ;;====================================================================== ;; R U N S ;;====================================================================== |
︙ | ︙ |
Modified tdb.scm from [b51589d681] to [d98014c985].
︙ | ︙ | |||
212 213 214 215 216 217 218 | ;; look up expected,tol,units from previous best fit test if they are all either #f or '' (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment " type: " type) (if (and (or (not expected)(equal? expected "")) (or (not tol) (equal? expected "")) (or (not units) (equal? expected ""))) | | | 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | ;; look up expected,tol,units from previous best fit test if they are all either #f or '' (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment " type: " type) (if (and (or (not expected)(equal? expected "")) (or (not tol) (equal? expected "")) (or (not units) (equal? expected ""))) (let-values (((new-expected new-tol new-units)(tdb:get-prev-tol-for-test tdb test-id category variable))) (set! expected new-expected) (set! tol new-tol) (set! units new-units))) (debug:print 4 "AFTER: category: " category " variable: " variable " value: " value ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment) ;; calculate status if NOT specified |
︙ | ︙ | |||
261 262 263 264 265 266 267 | ;; NOTE: Run this local with #f for db !!! (define (tdb:load-test-data test-id #!key (work-area #f)) (let loop ((lin (read-line))) (if (not (eof-object? lin)) (begin (debug:print 4 lin) | | | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | ;; NOTE: Run this local with #f for db !!! (define (tdb:load-test-data test-id #!key (work-area #f)) (let loop ((lin (read-line))) (if (not (eof-object? lin)) (begin (debug:print 4 lin) (tdb:csv->test-data test-id lin work-area: work-area) (loop (read-line))))) ;; roll up the current results. ;; FIXME: Add the status to (tdb:test-data-rollup db test-id #f work-area: work-area)) ;; WARNING: Do NOT call this for the parent test on an iterated test ;; Roll up test_data pass/fail results |
︙ | ︙ | |||
314 315 316 317 318 319 320 | ;; (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL') ;; THEN 'PASS' ;; ELSE status ;; END WHERE id=?;" ;; test-id test-id test-id test-id) )))) | | | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 | ;; (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL') ;; THEN 'PASS' ;; ELSE status ;; END WHERE id=?;" ;; test-id test-id test-id test-id) )))) (define (tdb:get-prev-tol-for-test tdb test-id category variable) ;; Finish me? (values #f #f #f)) ;;====================================================================== ;; S T E P S ;;====================================================================== |
︙ | ︙ |