Changes In Branch defstruct-srehman Through [c0371f685e] Excluding Merge-Ins
This is equivalent to a diff from e24aa68ed5 to c0371f685e
|
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
| ||
| 17:40 | inconsistency with defstruct var names and vars in db caused conflict, fixed check-in: 948f16e70d user: srehman tags: defstruct-srehman | |
| 17:14 | improved consistency, fixed error with switching tests in Test tab check-in: c0371f685e user: srehman tags: defstruct-srehman | |
| 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 | |
| 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 [f6381828f9].
| ︙ | ︙ | |||
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 [aefc44cdb9].
| ︙ | ︙ | |||
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)))
(set! 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 "-" "-")))
(set! res (make-db:test-rec run_id: run-id testname: testname item_path: item-path state: state status: status)))
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 |
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)
(set! res (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)
|
| ︙ | ︙ | |||
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 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 |
(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!!
;;
(define (db:get-test-info-by-ids dbstruct run-id test-ids)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(let ((res '()))
(sqlite3:for-each-row
(lambda (a . b)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (cons (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b))) res)))
;;(set! res (cons (apply vector a b) res)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
(string-intersperse (map conc test-ids) ",") ");"))
res))))
(define (db:get-test-info dbstruct run-id testname item-path)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row
(lambda (a . b)
(set! res (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b)))))
;;(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 [4495f8ce16].
| ︙ | ︙ | |||
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)))))) |
| ︙ | ︙ |