Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -804,11 +804,11 @@ (iup:attribute-set! tb "VALUE" val) (dboard:data-set-run-name! *data* val) (dashboard:update-run-command)))) (refresh-runs-list (lambda () (let* ((target (dboard:data-get-target-string *data*)) - (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f)) + (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f)) (runs-header (vector-ref runs-for-targ 0)) (runs-dat (vector-ref runs-for-targ 1)) (run-names (cons default-run-name (map (lambda (x) (db:get-value-by-header x runs-header "runname")) @@ -1048,11 +1048,11 @@ (key (conc lin ":" col)) (test-id (hash-table-ref/default cell-lookup key -1)) (cmd (conc toolpath " -test " (dboard:data-get-curr-run-id *data*) "," test-id "&"))) (system cmd))))) (updater (lambda () - (let* ((runs-dat (db:get-runs-by-patt db *keys* "%" #f #f #f)) + (let* ((runs-dat (db:get-runs-by-patt db *keys* "%" #f #f #f #f)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (run-id (dboard:data-get-curr-run-id *data*)) (tests-dat (let ((tdat (db:get-tests-for-run db run-id (hash-table-ref/default *searchpatts* "test-name" "%/%") (hash-table-keys *state-ignore-hash*) ;; '() Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1869,12 +1869,12 @@ ;; register a test run with the db ;; ;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) ;; to extract info from the structure returned ;; -(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name) - (let* ((tmp (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time"))) +(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit fields) ;; test-name) + (let* ((tmp (runs:get-std-run-fields keys (or fields '("id" "runname" "state" "status" "owner" "event_time")))) (keystr (car tmp)) (header (cadr tmp)) (res '()) (key-patt "") (runwildtype (if (substring-index "%" runnamepatt) "like" "glob")) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -926,12 +926,12 @@ (testpatt (if (args:get-arg "-testpatt") (args:get-arg "-testpatt") "%")) (keys (db:get-keys dbstruct)) ;; (runsda t (db:get-runs dbstruct runpatt #f #f '())) - (runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) - #f #f)) + (runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) + #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment"))) (runstmp (db:get-rows runsdat)) (header (db:get-header runsdat)) (runs (if (and (not (null? runstmp)) (args:get-arg "-since")) (let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since"))))) @@ -950,13 +950,13 @@ (dmode (let ((d (args:get-arg "-dumpmode"))) (if d (string->symbol d) #f))) (data (make-hash-table)) (fields-spec (if (args:get-arg "-fields") (extract-fields-constraints (args:get-arg "-fields")) - '(("runs" "id" "target" "runname") - (cons "tests" db:test-record-fields) ;; "id" "testname" "test_path") - ("steps" "id" "stepname")))) + (list (list "runs" "id" "target" "runname") + (cons "tests" db:test-record-fields) ;; "id" "testname" "test_path") + (list "steps" "id" "stepname")))) (runs-spec (let ((r (alist-ref "runs" fields-spec equal?))) (if (and r (not (null? r))) r (list "id")))) (tests-spec (let ((t (alist-ref "tests" fields-spec equal?))) (if (and t (null? t)) ;; all fields db:test-record-fields @@ -990,11 +990,11 @@ ;; (print "[" targetstr "]")))) (if (not dmode)(print targetstr)))) (let* ((run-id (db:get-value-by-header run header "id")) (runname (db:get-value-by-header run header "runname")) (tests (if tests-spec - (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc + (rmt:get-tests-for-run run-id testpatt '() '() #f #f #f 'testname 'asc ;; use qryvals if test-spec provided (if tests-spec (string-intersperse adj-tests-spec ",") ;; db:test-record-fields #f)) Index: mt.scm ================================================================== --- mt.scm +++ mt.scm @@ -41,11 +41,11 @@ ;; ;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) ;; to extract info from the structure returned ;; (define (mt:get-runs-by-patt keys runnamepatt targpatt) - (let loop ((runsdat (rmt:get-runs-by-patt keys runnamepatt targpatt 0 500)) + (let loop ((runsdat (rmt:get-runs-by-patt keys runnamepatt targpatt 0 500 #f)) (res '()) (offset 0) (limit 500)) ;; (print "runsdat: " runsdat) (let* ((header (vector-ref runsdat 0)) @@ -53,11 +53,11 @@ (full-list (append res runslst)) (have-more (eq? (length runslst) limit))) ;; (debug:print 0 "header: " header " runslst: " runslst " have-more: " have-more) (if have-more (let ((new-offset (+ offset limit)) - (next-batch (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit))) + (next-batch (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit #f))) (debug:print-info 4 "More than " limit " runs, have " (length full-list) " runs so far.") (debug:print-info 0 "next-batch: " next-batch) (loop next-batch full-list new-offset Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -553,12 +553,12 @@ (rmt:send-receive 'set-run-status #f (list run-id run-status msg))) (define (rmt:update-run-event_time run-id) (rmt:send-receive 'update-run-event_time #f (list run-id))) -(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit) - (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit))) +(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit fields) ;; fields of #f uses default + (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields))) (define (rmt:find-and-mark-incomplete run-id ovr-deadtime) (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime)) (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))))