Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2284,24 +2284,26 @@ (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 (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 #f)) + (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 (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)) @@ -2568,12 +2570,16 @@ (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) - res))) + ;;(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)) @@ -2645,11 +2651,16 @@ (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 testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum 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-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived))) + ;;(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id 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 id=?;") test-id) res)))) @@ -2679,11 +2690,11 @@ #f (lambda (db) (let ((res #f)) (sqlite3:for-each-row (lambda (a . b) - (set! res (apply vector 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)))) Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -63,30 +63,46 @@ (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)) - -(define (make-db:test)(make-vector 20)) -(define-inline (db:test-get-id vec) (vector-ref vec 0)) -(define-inline (db:test-get-run_id vec) (vector-ref vec 1)) -(define-inline (db:test-get-testname vec) (vector-ref vec 2)) -(define-inline (db:test-get-state vec) (vector-ref vec 3)) -(define-inline (db:test-get-status vec) (vector-ref vec 4)) -(define-inline (db:test-get-event_time vec) (vector-ref vec 5)) -(define-inline (db:test-get-host vec) (vector-ref vec 6)) -(define-inline (db:test-get-cpuload vec) (vector-ref vec 7)) -(define-inline (db:test-get-diskfree vec) (vector-ref vec 8)) -(define-inline (db:test-get-uname vec) (vector-ref vec 9)) -;; (define-inline (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10))) -(define-inline (db:test-get-rundir vec) (vector-ref vec 10)) -(define-inline (db:test-get-item-path vec) (vector-ref vec 11)) -(define-inline (db:test-get-run_duration vec) (vector-ref vec 12)) -(define-inline (db:test-get-final_logf vec) (vector-ref vec 13)) -(define-inline (db:test-get-comment vec) (vector-ref vec 14)) -(define-inline (db:test-get-process_id vec) (vector-ref vec 16)) -(define-inline (db:test-get-archived vec) (vector-ref vec 17)) +(require-extension typed-records) +(defstruct db:test-rec ((id -1) : number) + ((run_id -1) : number) + ((testname "") : string) + ((state "") : string) + ((status "") : string) + ((event_time -1) : number) + ((host "") : string) + ((cpuload -1) : number) + ((diskfree -1) : number) + ((uname "") : string) + ((rundir "") : string) + ((item_path "") : string) + ((run_duration -1) : number) + ((final_logf "") : string) + ((comment "") : string) + ((process_id -1) : number) + ((archived #f) : boolean)) + +(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)) +(define (db:test-get-host typed-rec) (db:test-rec-host typed-rec)) +(define (db:test-get-cpuload typed-rec) (db:test-rec-cpuload typed-rec)) +(define (db:test-get-diskfree typed-rec) (db:test-rec-diskfree 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-rundir 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)))