Overview
Comment: | fixed error with db.scm |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | defstruct-srehman |
Files: | files | file ages | folders |
SHA1: |
f5247f66842a4b9b1e88c6424a29d8fe |
User & Date: | srehman on 2016-09-19 17:49:02 |
Other Links: | branch diff | manifest | tags |
Context
2016-09-20
| ||
13:25 | updateded db:get-tests-for-run method with defstruct check-in: d5c885ef29 user: srehman tags: defstruct-srehman | |
2016-09-19
| ||
17:49 | fixed error with db.scm check-in: f5247f6684 user: srehman tags: defstruct-srehman | |
11:13 | merged with v1.62 latest build check-in: d854ad72ea user: srehman tags: defstruct-srehman | |
Changes
Modified dashboard.scm from [7743efb660] to [50a3705d51].
︙ | ︙ | |||
1394 1395 1396 1397 1398 1399 1400 | (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) | | | > | 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 | (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))) (print a b) (if (and anum bnum) (< anum bnum) (string<= aval bval))))))) (define (dashboard:safe-cadr-assoc name lst) (let ((res (assoc name lst))) |
︙ | ︙ |
Modified db.scm from [c566a984d2] to [a28e3b57c0].
︙ | ︙ | |||
2249 2250 2251 2252 2253 2254 2255 | ";" ))) (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) | | > > > > > > | 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 | ";" ))) (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 (alist->db:test-rec (db:qry-gen-alist qryvalstr (cons a b)))) (print (db:test-rec->alist res))) db qry run-id ))) (case qryvals ((shortlist)(map db:test-short-record->norm res)) ((#f) res) |
︙ | ︙ |
Modified db_records.scm from [d34e97aebf] to [2b001bb132].
︙ | ︙ | |||
78 79 80 81 82 83 84 | ((uname "") : string) ((rundir "") : string) ((item_path "") : string) ((run_duration -1) : number) ((final_logf "") : string) ((comment "") : string) ((process_id -1) : number) | | > > > > > > > > > > > > > > > | 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 | ((uname "") : string) ((rundir "") : string) ((item_path "") : string) ((run_duration -1) : number) ((final_logf "") : string) ((comment "") : string) ((process_id -1) : number) ((archived -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-testname 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)) |
︙ | ︙ |