936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
|
#f)))
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
(let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
(runpatt (args:get-arg "-list-runs"))
(testpatt (common:args-get-testpatt #f))
;; (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 '("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")))))
(let loop ((hed (car runstmp))
|
|
|
|
|
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
|
#f)))
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
(let* (;; (dbstruct (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
(runpatt (args:get-arg "-list-runs"))
(testpatt (common:args-get-testpatt #f))
;; (if (args:get-arg "-testpatt")
;; (args:get-arg "-testpatt")
;; "%"))
(keys (rmt:get-keys)) ;; (db:get-keys dbstruct))
;; (runsda t (db:get-runs dbstruct runpatt #f #f '()))
(runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct 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")))))
(let loop ((hed (car runstmp))
|
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
|
(if (not dmode)
(print targetstr)
(hash-table-set! data "targets" (cons targetstr (hash-table-ref/default data "targets" '())))
)))
(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
;; use qryvals if test-spec provided
(if tests-spec
(string-intersperse adj-tests-spec ",")
;; db:test-record-fields
#f))
'())))
(case dmode
|
|
|
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
|
(if (not dmode)
(print targetstr)
(hash-table-set! data "targets" (cons targetstr (hash-table-ref/default data "targets" '())))
)))
(let* ((run-id (db:get-value-by-header run header "id"))
(runname (db:get-value-by-header run header "runname"))
(tests (if tests-spec
(rmt:get-tests-for-run run-id testpatt '() '() #f #f #f 'testname 'asc ;; (db:get-tests-for-run dbstruct 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))
'())))
(case dmode
|
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
|
"\n uname: " (db:test-get-uname test)
"\n rundir: " (db:test-get-rundir test)
"\n rundir: " ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb*
(db:test-get-rundir test) ;; )
)
;; Each test
;; DO NOT remote run
(let ((steps (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
(for-each
(lambda (step)
(format #t
" Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
(tdb:step-get-stepname step)
(tdb:step-get-state step)
(tdb:step-get-status step)
|
|
|
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
|
"\n uname: " (db:test-get-uname test)
"\n rundir: " (db:test-get-rundir test)
"\n rundir: " ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb*
(db:test-get-rundir test) ;; )
)
;; Each test
;; DO NOT remote run
(let ((steps (rmt:get-steps-for-test run-id (db:test-get-id test)))) ;; (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
(for-each
(lambda (step)
(format #t
" Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
(tdb:step-get-stepname step)
(tdb:step-get-state step)
(tdb:step-get-status step)
|