1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
|
(define (operate-on action #!key (mode #f)(target-in #f)(runname-in #f)(keys-in #f)(keyvals-in #f)) ;; #f is "use default"
(let* ((runrec (runs:runrec-make-record))
(target (or target-in (common:args-get-target))) ;; eventually get rid of the call to common:args-get-target
(runname (or runname-in
(args:get-arg "-runname"))) ;; eventually get rid of the get-arg calls
(testpatt (or (args:get-arg "-testpatt")
(and (eq? action 'archive) ;; if it is an archive command fallback to MT_TEST_NAME and MT_ITEMPATH
(common:get-full-testname))
(and (eq? action 'kill-runs)
"%/%") ;; I'm just guessing that this is correct :(
(common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")))
))) ;;
(cond
((not target)
(debug:print-error 0 *default-log-port* "Missing required parameter for "
|
|
|
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
|
(define (operate-on action #!key (mode #f)(target-in #f)(runname-in #f)(keys-in #f)(keyvals-in #f)) ;; #f is "use default"
(let* ((runrec (runs:runrec-make-record))
(target (or target-in (common:args-get-target))) ;; eventually get rid of the call to common:args-get-target
(runname (or runname-in
(args:get-arg "-runname"))) ;; eventually get rid of the get-arg calls
(testpatt (or (args:get-arg "-testpatt")
(and (eq? action 'archive) ;; if it is an archive command fallback to MT_TEST_NAME and MT_ITEMPATH
(common:get-full-test-name))
(and (eq? action 'kill-runs)
"%/%") ;; I'm just guessing that this is correct :(
(common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")))
))) ;;
(cond
((not target)
(debug:print-error 0 *default-log-port* "Missing required parameter for "
|
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
|
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
;; else do a general-run-call
(general-run-call
"-archive"
"Archive"
(lambda (target runname keys keyvals)
(operate-on 'archive target-in: target runname-in: runame ))))
;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================
(if (args:get-arg "-extract-ods")
(general-run-call
|
|
|
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
|
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
;; else do a general-run-call
(general-run-call
"-archive"
"Archive"
(lambda (target runname keys keyvals)
(operate-on 'archive target-in: target runname-in: runname ))))
;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================
(if (args:get-arg "-extract-ods")
(general-run-call
|