Changes In Branch defstruct-srehman Through [e0b23f144a] Excluding Merge-Ins
This is equivalent to a diff from e24aa68ed5 to e0b23f144a
|
2016-09-26
| ||
| 13:40 | Convert from vector record to defstruct for dbr:dbstruct check-in: 7c0396e31d user: mrwellan tags: v1.62 | |
|
2016-09-23
| ||
| 15:18 | Update db check-in: b6c50d722b user: ritikaag tags: db | |
| 14:39 | replaced vector return to db:test-rec return in two function calls check-in: e5509ad8b9 user: srehman tags: defstruct-srehman | |
| 12:28 | sorted-tests tests for db:test-rec instead of vector check-in: e0b23f144a user: srehman tags: defstruct-srehman | |
| 12:26 | added more uniform naming scheme to db:test-rec defstruct check-in: 6ce8a4c44e user: srehman tags: defstruct-srehman | |
| 11:16 | merged with latest v1.62 check-in: d9c3068419 user: srehman tags: defstruct-srehman | |
|
2016-09-21
| ||
| 09:11 | moved readline fix include out of the if. Update copyright date. Block when running db migration IF version bumped check-in: e24aa68ed5 user: mrwellan tags: v1.62 | |
|
2016-09-19
| ||
| 11:08 | Put the db migration into a thread to not block starting the dashboard check-in: 3046301f07 user: mrwellan tags: v1.62 | |
Modified dashboard.scm from [40b640dfe5] to [f755ea6a07].
| ︙ | ︙ | |||
900 901 902 903 904 905 906 | (if (and buttondat (hash-table? testsdat-by-name)) (let* ((testdat (let ((matching (hash-table-ref/default testsdat-by-name testname #f))) ;; (filter ;; (lambda (x)(equal? (test:test-get-fullname x) testname)) ;; testsdat))) (if (not matching) | | > | 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 | (if (and buttondat (hash-table? testsdat-by-name)) (let* ((testdat (let ((matching (hash-table-ref/default testsdat-by-name testname #f))) ;; (filter ;; (lambda (x)(equal? (test:test-get-fullname x) testname)) ;; testsdat))) (if (not matching) ;;(vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "") (make-db:test-rec (id -1)) ;; (car matching)))) matching))) (testname (db:test-get-testname testdat)) (itempath (db:test-get-item-path testdat)) (testfullname (test:test-get-fullname testdat)) (teststatus (db:test-get-status testdat)) (teststate (db:test-get-state testdat)) |
| ︙ | ︙ | |||
1419 1420 1421 1422 1423 1424 1425 |
(if (dboard:tabdat-filters-changed tabdat)
0
last-update)
*dashboard-mode*)
'()))) ;; get 'em all
;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
(sort tdat (lambda (a b)
| | | | 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 |
(if (dboard:tabdat-filters-changed tabdat)
0
last-update)
*dashboard-mode*)
'()))) ;; get 'em all
;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
(sort tdat (lambda (a b)
(let* ((aval (db:test-get-testname a));;(vector-ref a 2))
(bval (db:test-get-testname b));;(vector-ref b 2))
(anum (string->number aval))
(bnum (string->number bval)))
(if (and anum bnum)
(< anum bnum)
(string<= aval bval)))))))
|
| ︙ | ︙ |
Modified db.scm from [248b7f3532] to [8814050e9a].
| ︙ | ︙ | |||
2256 2257 2258 2259 2260 2261 2262 | ";" ))) (debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) | | > > > | 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 | ";" ))) (debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) ;;(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) ;;(print (cons a b)) (set! res (cons (alist->db:test-rec (db:qry-gen-alist qryvalstr (cons a b))) res))) db qry run-id ))) (case qryvals ((shortlist)(map db:test-short-record->norm res)) ((#f) res) |
| ︙ | ︙ | |||
2289 2290 2291 2292 2293 2294 2295 |
(if tests-match-qry (conc " AND (" tests-match-qry ") ") ""))))
(debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
(db:with-db dbstruct run-id #f
(lambda (db)
(sqlite3:for-each-row
(lambda (id testname item-path state status)
;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
| | > | | > | 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 |
(if tests-match-qry (conc " AND (" tests-match-qry ") ") ""))))
(debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
(db:with-db dbstruct run-id #f
(lambda (db)
(sqlite3:for-each-row
(lambda (id testname item-path state status)
;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
;;(set! res (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res)))
(cons (make-db:test-rec id: id testname: testname item_path: item-path state: state status: status) res))
db
qry
run-id)))
res))
(define (db:get-testinfo-state-status dbstruct run-id test-id)
(let ((res '()))
(db:with-db dbstruct run-id #f
(lambda (db)
(sqlite3:for-each-row
(lambda (run-id testname item-path state status)
;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
;;(set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-")))
(cons (make-db:test-rec run_id: run-id testname: testname item_path: item-path state: state status: status) res))
db
"SELECT run_id,testname,item_path,state,status FROM tests WHERE id=?;"
test-id)))
res))
;; get a useful subset of the tests data (used in dashboard
;; use db:mintest-get-{id ,run_id,testname ...}
|
| ︙ | ︙ | |||
2573 2574 2575 2576 2577 2578 2579 |
dbstruct)) ;; still settling on when to use dbstruct or dbdat
(db (db:dbdat-get-db dbdat))
(res '()))
(db:delay-if-busy dbdat)
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
| | > > > > | | 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 |
dbstruct)) ;; still settling on when to use dbstruct or dbdat
(db (db:dbdat-get-db dbdat))
(res '()))
(db:delay-if-busy dbdat)
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
;;(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
(cons (make-db:test-rec id: id run-id: run-id testname: testname state: state status: status event_time: event-time
host: host cpuload: cpuload diskfree: diskfree uname: uname rundir: rundir item_path: item-path
run_duration: run-duration final_logf: final-logf comment: comment shortdir: shortdir
attemptnum: attemptnum archived: archived )
res))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
run-id)
res))
(define (db:replace-test-records dbstruct run-id testrecs)
(db:with-db dbstruct run-id #t
|
| ︙ | ︙ | |||
2648 2649 2650 2651 2652 2653 2654 |
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
| | | > > > > | 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 |
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id test-name state status event-time host cpu-load disk-free uname run-dir item-path run-duration final-logf comment short-dir attempt-num archived)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
;;(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final-logf comment short-dir attemptnum archived)))
(set! res (make-db:test-rec id: id run-id: run-id test-name: test-name state: state status: status event-time: event-time
host: host cpu-load: cpu-load disk-free: disk-free uname: uname run-dir: run-dir item-path: item-path
run-duration: run-duration final-logf: final-logf comment: comment short-dir: short-dir
attempt-num: attempt-num archived: archived)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))))
;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
|
| ︙ | ︙ | |||
2684 2685 2686 2687 2688 2689 2690 |
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row
(lambda (a . b)
| | | 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 |
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row
(lambda (a . b)
(print a));;set! res (apply vector a b)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;")
test-name item-path)
res))))
(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)
(db:with-db
|
| ︙ | ︙ |
Modified db_records.scm from [64b6bb0323] to [4eb9714f45].
| ︙ | ︙ | |||
63 64 65 66 67 68 69 70 | ;; (define (dbr:dbstruct-get-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f)) (define (dbr:dbstruct-set-localdb! v run-id db) (hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db)) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | < | | | | | | | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | ;; (define (dbr:dbstruct-get-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f)) (define (dbr:dbstruct-set-localdb! v run-id db) (hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db)) (require-extension typed-records) (defstruct db:test-rec ((id -1) : number) ((run-id -1) : number) ((test-name "") : string) ((state "") : string) ((status "") : string) ((event-time -1) : number) ((host "") : string) ((cpu-load -1) : number) ((disk-free -1) : number) ((uname "") : string) ((run-dir "") : string) ((item-path "") : string) ((run-duration -1) : number) ((final-logf "") : string) ((comment "") : string) ((process-id -1) : number) ((archived -1) : number) ((short-dir -1) : number) ((attempt-num -1) : number)) (define (db:qry-gen-alist qrystr listvals) (define listqry (string-split qrystr ",")) (if (null? listqry) '() (let loop ((strhead (car listqry)) (strtail (cdr listqry)) (valhead (car listvals)) (valtail (cdr listvals)) (res '())) (let* ((slot-val-pair (cons (string->symbol strhead) valhead))) (if (or (null? strtail) (null? valtail)) (cons slot-val-pair res);;(print strhead valhead));;(cons (cons (string->symbol strhead) valhead) res)) (loop (car strtail)(cdr strtail)(car valtail)(cdr valtail)(cons slot-val-pair res))))))) (define (db:test-get-id typed-rec) (db:test-rec-id typed-rec)) (define (db:test-get-run_id typed-rec) (db:test-rec-run-id typed-rec)) (define (db:test-get-testname typed-rec) (db:test-rec-test-name typed-rec)) (define (db:test-get-state typed-rec) (db:test-rec-state typed-rec)) (define (db:test-get-status typed-rec) (db:test-rec-status typed-rec)) (define (db:test-get-event_time typed-rec) (db:test-rec-event-time typed-rec)) (define (db:test-get-host typed-rec) (db:test-rec-host typed-rec)) (define (db:test-get-cpuload typed-rec) (db:test-rec-cpu-load typed-rec)) (define (db:test-get-diskfree typed-rec) (db:test-rec-disk-free typed-rec)) (define (db:test-get-uname typed-rec) (db:test-rec-uname typed-rec)) (define (db:test-get-rundir typed-rec) (db:test-rec-run-dir typed-rec)) (define (db:test-get-item-path typed-rec) (db:test-rec-item-path typed-rec)) (define (db:test-get-run_duration typed-rec) (db:test-rec-run-duration typed-rec)) (define (db:test-get-final_logf typed-rec) (db:test-rec-final-logf typed-rec)) (define (db:test-get-comment typed-rec) (db:test-rec-comment typed-rec)) (define (db:test-get-process_id typed-rec) (db:test-rec-process-id typed-rec)) (define (db:test-get-archived typed-rec) (db:test-rec-archived typed-rec)) ;; (define-inline (db:test-get-pass_count vec) (vector-ref vec 15)) ;; (define-inline (db:test-get-fail_count vec) (vector-ref vec 16)) (define-inline (db:test-get-fullname vec) (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec))) ;; replace runs:make-full-test-name with this routine |
| ︙ | ︙ |
Modified runs.scm from [de4f2b1394] to [ac6ff009be].
| ︙ | ︙ | |||
1698 1699 1700 1701 1702 1703 1704 | (thread-start! worker-thread)) (else (debug:print-info 0 *default-log-port* "action not recognised " action))) ;; actions that operate on one test at a time can be handled below ;; (let ((sorted-tests (filter | | | 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 | (thread-start! worker-thread)) (else (debug:print-info 0 *default-log-port* "action not recognised " action))) ;; actions that operate on one test at a time can be handled below ;; (let ((sorted-tests (filter db:test-rec? (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr (db:test-get-rundir a)) ;; ) ;; (filedb:get-path *fdb* (db:test-get-rundir a))) (dirb ;; (rmt:sdb-qry 'getstr (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b)))) (if (and (string? dira)(string? dirb)) (> (string-length dira)(string-length dirb)) #f)))))) |
| ︙ | ︙ |