@@ -1056,23 +1056,34 @@ ;; 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" +(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 (common:args-get-target))) + (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") + (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 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 (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") + ((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") @@ -1081,13 +1092,13 @@ (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) + 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))))) @@ -1883,11 +1894,11 @@ ;; else do a general-run-call (general-run-call "-archive" "Archive" (lambda (target runname keys keyvals) - (operate-on 'archive)))) + (operate-on 'archive target-in: target runname-in: runame )))) ;;====================================================================== ;; Extract a spreadsheet from the runs database ;;======================================================================