Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -117,11 +117,16 @@ #t (let ((cmd (vector-ref dat 0)) (params (vector-ref dat 1))) (case (if (symbol? cmd) cmd - (string->symbol cmd)) + (if (string? cmd) + (string->symbol cmd) + (begin + (debug:print 0 *default-log-port* "ERROR: received bad data in execute-requests \"" cmd "\"" + " and params " params) + (exit 1)))) ;;=============================================== ;; READ/WRITE QUERIES ;;=============================================== Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -904,11 +904,12 @@ (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 "" "") + ;;(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)) @@ -1423,12 +1424,12 @@ 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 (vector-ref a 2)) - (bval (vector-ref b 2)) + (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))))))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2279,11 +2279,14 @@ (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))) + ;;(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 (db:test-rec-from-qry-long (cons a b)) res))) + db qry run-id ))) (case qryvals @@ -2292,18 +2295,11 @@ (else res))))) (define (db:test-short-record->norm inrec) ;; "id,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 - (vector (vector-ref inrec 0) ;; id - (vector-ref inrec 1) ;; run_id - (vector-ref inrec 2) ;; testname - (vector-ref inrec 4) ;; state - (vector-ref inrec 5) ;; status - -1 "" -1 -1 "" "-" - (vector-ref inrec 3) ;; item-path - -1 "-" "-")) + (make-db:test-rec id: -1)) (define (db:get-tests-for-run-state-status dbstruct run-id testpatt) (let* ((res '()) (tests-match-qry (tests:match->sqlqry testpatt)) (qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " @@ -2312,24 +2308,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))) + (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 #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 "-" "-"))) + (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)) @@ -2594,13 +2592,17 @@ 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) + (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 (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)) @@ -2671,13 +2673,17 @@ 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 testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived) + (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 (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 item-path run_duration final-logf comment short-dir attemptnum archived))) + (set! res (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 ))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;") test-id) res)))) @@ -2692,11 +2698,12 @@ (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 (apply vector a b) res))) + (set! res (cons (db:test-rec-from-qry-long (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)))) @@ -2707,11 +2714,12 @@ #f (lambda (db) (let ((res #f)) (sqlite3:for-each-row (lambda (a . b) - (set! res (apply vector a b))) + (set! res (db:test-rec-from-qry-long (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)))) @@ -2882,18 +2890,26 @@ ;; foo,abl, 1.2, 1.3, 0.1 ;; foo,bra, 1.2, pass, silly stuff ;; faz,bar, 10, 8mA, , ,"this is a comment" ;; EOF + +(define (db:csv->list-safe csvdata) + (if (string? csvdata) + (csv->list (make-csv-reader + (open-input-string csvdata) + '((strip-leading-whitespace? #t) + (strip-trailing-whitespace? #t)))) + (begin + (debug:print 0 *default-log-port* "ERROR: received non-string data for csv") + '()))) + (define (db:csv->test-data dbstruct run-id test-id csvdata) (debug:print 4 *default-log-port* "test-id " test-id ", csvdata: " csvdata) (let* ((dbdat (db:get-db dbstruct run-id)) (db (db:dbdat-get-db dbdat)) - (csvlist (csv->list (make-csv-reader - (open-input-string csvdata) - '((strip-leading-whitespace? #t) - (strip-trailing-whitespace? #t)))))) ;; (csv->list csvdata))) + (csvlist (db:csv->list-safe csvdata))) (for-each (lambda (csvrow) (let* ((padded-row (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9)) (category (list-ref padded-row 0)) (variable (list-ref padded-row 1)) Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -65,30 +65,78 @@ (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f)) (define (dbr:dbstruct-localdb-set! v run-id db) (hash-table-set! (dbr:dbstruct-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 -1) : number) + ((shortdir -1) : number) + ((attemptnum -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-rec-from-qry-long listvals) + (make-db:test-rec id: (list-ref listvals 0) run_id: (list-ref listvals 1) testname: (list-ref listvals 2) + state: (list-ref listvals 3) status: (list-ref listvals 4) event_time: (list-ref listvals 5) + host: (list-ref listvals 6) cpuload: (list-ref listvals 7) diskfree: (list-ref listvals 8) + uname: (list-ref listvals 9) rundir: (list-ref listvals 10) item_path: (list-ref listvals 11) + run_duration: (list-ref listvals 12) final_logf: (list-ref listvals 13) comment: (list-ref listvals 14) + shortdir: (list-ref listvals 15) attemptnum: (list-ref listvals 16) archived: (list-ref listvals 17))) + +(define (db:test-rec-from-qry-short listvals) + (make-db:test-rec id: (list-ref listvals 0) run_id: (list-ref listvals 1) testname: (list-ref listvals 2) + state: (list-ref listvals 3) status: (list-ref listvals 4) event_time: (list-ref listvals 5) + host: (list-ref listvals 6) cpuload: (list-ref listvals 7) diskfree: (list-ref listvals 8) + uname: (list-ref listvals 9) rundir: (list-ref listvals 10) item_path: (list-ref listvals 11) + run_duration: (list-ref listvals 12) final_logf: (list-ref listvals 13) comment: (list-ref listvals 14))) + +(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))) @@ -98,17 +146,17 @@ (if (equal? itempath "") testname (conc testname "/" itempath))) (define-inline (db:test-get-first_err vec) (printable (vector-ref vec 15))) (define-inline (db:test-get-first_warn vec) (printable (vector-ref vec 16))) ;; RADT => reference 16 is repeated -(define-inline (db:test-set-cpuload! vec val)(vector-set! vec 7 val)) -(define-inline (db:test-set-diskfree! vec val)(vector-set! vec 8 val)) -(define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val)) -(define-inline (db:test-set-state! vec val)(vector-set! vec 3 val)) -(define-inline (db:test-set-status! vec val)(vector-set! vec 4 val)) -(define-inline (db:test-set-run_duration! vec val)(vector-set! vec 12 val)) -(define-inline (db:test-set-final_logf! vec val)(vector-set! vec 13 val)) +(define-inline (db:test-set-cpuload! vec val) (db:test-rec-cpuload-set! vec val)) +(define-inline (db:test-set-diskfree! vec val) (db:test-rec-diskfree-set! vec val)) +(define-inline (db:test-set-testname! vec val) (db:test-rec-testname-set! vec val)) +(define-inline (db:test-set-state! vec val) (db:test-rec-state-set! vec val)) +(define-inline (db:test-set-status! vec val) (db:test-rec-status-set! vec val)) +(define-inline (db:test-set-run_duration! vec val) (db:test-rec-run_duration-set! vec val)) +(define-inline (db:test-set-final_logf! vec val) (db:test-rec-final_logf-set! vec val)) ;; Test record utility functions ;; Is a test a toplevel? ;; @@ -118,17 +166,17 @@ ;; make-vector-record "" db mintest id run_id testname state status event_time item_path ;; RADT => purpose of mintest?? ;; (define (make-db:mintest)(make-vector 7)) -(define-inline (db:mintest-get-id vec) (vector-ref vec 0)) -(define-inline (db:mintest-get-run_id vec) (vector-ref vec 1)) -(define-inline (db:mintest-get-testname vec) (vector-ref vec 2)) -(define-inline (db:mintest-get-state vec) (vector-ref vec 3)) -(define-inline (db:mintest-get-status vec) (vector-ref vec 4)) -(define-inline (db:mintest-get-event_time vec) (vector-ref vec 5)) -(define-inline (db:mintest-get-item_path vec) (vector-ref vec 6)) +(define-inline (db:mintest-get-id vec) (db:test-rec-id vec)) +(define-inline (db:mintest-get-run_id vec) (db:test-rec-run_id vec)) +(define-inline (db:mintest-get-testname vec) (db:test-rec-testname vec)) +(define-inline (db:mintest-get-state vec) (db:test-rec-state vec)) +(define-inline (db:mintest-get-status vec) (db:test-rec-status vec)) +(define-inline (db:mintest-get-event_time vec) (db:test-rec-event_time vec)) +(define-inline (db:mintest-get-item_path vec) (db:test-rec-item_path vec)) ;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk (define (make-db:testmeta)(make-vector 10 "")) (define-inline (db:testmeta-get-id vec) (vector-ref vec 0)) (define-inline (db:testmeta-get-testname vec) (vector-ref vec 1)) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -1018,16 +1018,19 @@ (cons (car dat)(string-split (cadr dat) ",")) ;; "id,target,runname" dat))) (string-split fields-spec "+"))) (define (get-value-by-fieldname datavec test-field-index fieldname) + (if (db:test-rec? datavec) + (let ((test-rec-alist (db:test-rec->alist datavec))) + (alist-ref (string->symbol fieldname) test-rec-alist)) (let ((indx (hash-table-ref/default test-field-index fieldname #f))) (if indx (if (>= indx (vector-length datavec)) #f ;; index to high, should raise an error I suppose (vector-ref datavec indx)) - #f))) + #f)))) ;; NOTE: list-runs and list-db-targets operate on local db!!! ;; ;; IDEA: megatest list -runname blah% ... ;; @@ -1161,20 +1164,32 @@ (begin (debug:print-error 0 *default-log-port* "Bad data in test record? " test) (print "exn=" (condition->list exn)) (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (print-call-chain (current-error-port))) - (let* ((test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-get-id test)) - (testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-get-testname test)) - (itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-get-item-path test)) - (comment (if (member "comment" tests-spec)(get-value-by-fieldname test test-field-index "comment" ) #f)) ;; (db:test-get-comment test)) - (tstate (if (member "state" tests-spec)(get-value-by-fieldname test test-field-index "state" ) #f)) ;; (db:test-get-state test)) - (tstatus (if (member "status" tests-spec)(get-value-by-fieldname test test-field-index "status" ) #f)) ;; (db:test-get-status test)) - (event-time (if (member "event_time" tests-spec)(get-value-by-fieldname test test-field-index "event_time" ) #f)) ;; (db:test-get-event_time test)) - (rundir (if (member "rundir" tests-spec)(get-value-by-fieldname test test-field-index "rundir" ) #f)) ;; (db:test-get-rundir test)) - (final_logf (if (member "final_logf" tests-spec)(get-value-by-fieldname test test-field-index "final_logf" ) #f)) ;; (db:test-get-final_logf test)) - (run_duration (if (member "run_duration" tests-spec)(get-value-by-fieldname test test-field-index "run_duration") #f)) ;; (db:test-get-run_duration test)) + (let* ( + (test-id (db:test-rec-id test)) + (testname (db:test-rec-testname test)) + (itempath (db:test-rec-item_path test)) + (comment (db:test-rec-comment test)) + (tstate (db:test-rec-state test)) + (tstatus (db:test-rec-status test)) + (event-time (db:test-rec-event_time test)) + (rundir (db:test-rec-rundir test)) + (final_logf (db:test-rec-final_logf test)) + (run_duration (db:test-rec-run_duration test)) + (fullname (db:test-rec-testname test)) + ;;(test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-get-id test)) + ;;(testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-get-testname test)) + ;;(itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-get-item-path test)) + ;;(comment (if (member "comment" tests-spec)(get-value-by-fieldname test test-field-index "comment" ) #f)) ;; (db:test-get-comment test)) + ;;(tstate (if (member "state" tests-spec)(get-value-by-fieldname test test-field-index "state" ) #f)) ;; (db:test-get-state test)) + ;;(tstatus (if (member "status" tests-spec)(get-value-by-fieldname test test-field-index "status" ) #f)) ;; (db:test-get-status test)) + ;;(event-time (if (member "event_time" tests-spec)(get-value-by-fieldname test test-field-index "event_time" ) #f)) ;; (db:test-get-event_time test)) + ;;(rundir (if (member "rundir" tests-spec)(get-value-by-fieldname test test-field-index "rundir" ) #f)) ;; (db:test-get-rundir test)) + ;;(final_logf (if (member "final_logf" tests-spec)(get-value-by-fieldname test test-field-index "final_logf" ) #f)) ;; (db:test-get-final_logf test)) + ;;(run_duration (if (member "run_duration" tests-spec)(get-value-by-fieldname test test-field-index "run_duration") #f)) ;; (db:test-get-run_duration test)) (fullname (conc testname (if (equal? itempath "") "" (conc "(" itempath ")"))))) (case dmode Index: run_records.scm ================================================================== --- run_records.scm +++ run_records.scm @@ -6,10 +6,12 @@ ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== + +(include "db_records.scm") (define-inline (runs:runrec-make-record) (make-vector 13)) (define-inline (runs:runrec-get-target vec)(vector-ref vec 0)) ;; a/b/c (define-inline (runs:runrec-get-runname vec)(vector-ref vec 1)) ;; string (define-inline (runs:runrec-testpatt vec)(vector-ref vec 2)) ;; a,b/c,d% @@ -22,18 +24,18 @@ (define-inline (runs:runrec-transport vec)(vector-ref vec 9)) ;; 'http (define-inline (runs:runrec-db vec)(vector-ref vec 10)) ;; (if 'fs) (define-inline (runs:runrec-top-path vec)(vector-ref vec 11)) ;; *toppath* (define-inline (runs:runrec-run_id vec)(vector-ref vec 12)) ;; run-id -(define-inline (test:get-id vec) (vector-ref vec 0)) -(define-inline (test:get-run_id vec) (vector-ref vec 1)) -(define-inline (test:get-test-name vec)(vector-ref vec 2)) -(define-inline (test:get-state vec) (vector-ref vec 3)) -(define-inline (test:get-status vec) (vector-ref vec 4)) -(define-inline (test:get-item-path vec)(vector-ref vec 5)) +(define-inline (test:get-id vec) (db:test-rec-id vec)) +(define-inline (test:get-run_id vec) (db:test-rec-run_id vec)) +(define-inline (test:get-test-name vec)(db:test-rec-testname vec)) +(define-inline (test:get-state vec) (db:test-rec-state vec)) +(define-inline (test:get-status vec) (db:test-rec-status vec)) +(define-inline (test:get-item-path vec)(db:test-rec-item_path vec)) (define-inline (test:test-get-fullname test) (conc (db:test-get-testname test) (if (equal? (db:test-get-item-path test) "") "" (conc "(" (db:test-get-item-path test) ")")))) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1700,11 +1700,11 @@ (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 - vector? + 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)) Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -148,11 +148,11 @@ # RUNDEAD [system exit 56] [server] # force use of server always -# required yes +required yes # Use http instead of direct filesystem access transport http # transport fs # transport nmsg