1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
|
;;======================================================================
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
;; is done first
(define (operate-on action #!key (mode #f)) ;; #f is "use default"
(let* ((runrec (runs:runrec-make-record))
(target (common:args-get-target)))
(cond
((not target)
(debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify -target or -reqtarg")
(exit 1))
((not (or (args:get-arg ":runname")
(args:get-arg "-runname")))
(debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify the run name pattern with -runname patt")
((not (or (args:get-arg "-testpatt") (eq? action 'kill-runs)))
(debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify the test pattern with -testpatt")
(exit 3))
(else
(if (not (car *configinfo*))
(begin
(debug:print-error 0 *default-log-port* "Attempted " action "on test(s) but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(begin
;; check for correct version, exit with message if not correct
(common:exit-on-version-changed)
(runs:operate-on action
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
(common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
state: (common:args-get-state)
status: (common:args-get-status)
new-state-status: (args:get-arg "-set-state-status")
mode: mode)))
(set! *didsomething* #t)))))
(if (args:get-arg "-kill-runs")
(general-run-call
|
|
>
>
>
>
>
>
>
>
|
>
|
>
<
|
|
>
|
|
>
|
|
|
|
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
|
;;======================================================================
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
;; is done first
(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 "
action ", you must specify -target or -reqtarg")
(exit 1))
((not runname)
(debug:print-error 0 *default-log-port* "Missing required parameter for "
action ", you must specify the run name pattern with -runname patt")
(exit 2))
((not testpatt)
(debug:print-error 0 *default-log-port* "Missing required parameter for "
action ", you must specify the test pattern with -testpatt")
(exit 3))
(else
(if (not (car *configinfo*))
(begin
(debug:print-error 0 *default-log-port* "Attempted " action "on test(s) but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(begin
;; check for correct version, exit with message if not correct
(common:exit-on-version-changed)
(runs:operate-on action
target
runname
testpatt
state: (common:args-get-state)
status: (common:args-get-status)
new-state-status: (args:get-arg "-set-state-status")
mode: mode)))
(set! *didsomething* #t)))))
(if (args:get-arg "-kill-runs")
(general-run-call
|
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
|
;; 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))))
;;======================================================================
;; 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: runame ))))
;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================
(if (args:get-arg "-extract-ods")
(general-run-call
|