639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
|
(set! *didsomething* #t)))
;; handle a clean-cache request as early as possible
;;
(if (args:get-arg "-clean-cache")
(let ((toppath (launch:setup)))
(set! *didsomething* #t) ;; suppress the help output.
(runs:clean-cache (or (getenv "MT_TARGET")
(args:get-arg "-target")
(args:get-arg "-remtarg"))
(args:get-arg "-runname")
toppath)))
(if (args:get-arg "-env2file")
(begin
(save-environment-as-files (args:get-arg "-env2file"))
(set! *didsomething* #t)))
|
|
<
<
|
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
|
(set! *didsomething* #t)))
;; handle a clean-cache request as early as possible
;;
(if (args:get-arg "-clean-cache")
(let ((toppath (launch:setup)))
(set! *didsomething* #t) ;; suppress the help output.
(runs:clean-cache (common:args-get-target)
(args:get-arg "-runname")
toppath)))
(if (args:get-arg "-env2file")
(begin
(save-environment-as-files (args:get-arg "-env2file"))
(set! *didsomething* #t)))
|
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
|
"-kill-runs"
"kill runs"
(lambda (target runname keys keyvals)
(operate-on 'kill-runs mode: #f)
)))
(if (args:get-arg "-kill-rerun")
(let* ((target-patt (args:get-arg "-target"))
(runname-patt (args:get-arg "-runname")))
(cond ((not target-patt)
(debug:print-error 0 *default-log-port* "Missing target, must specify target for -kill-rerun with -target <target name>")
(exit 1))
((not runname-patt)
(debug:print-error 0 *default-log-port* "Missing runname, must specify runname for -kill-rerun with -runname <run name>")
(exit 1))
|
|
|
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
|
"-kill-runs"
"kill runs"
(lambda (target runname keys keyvals)
(operate-on 'kill-runs mode: #f)
)))
(if (args:get-arg "-kill-rerun")
(let* ((target-patt (common:args-get-target))
(runname-patt (args:get-arg "-runname")))
(cond ((not target-patt)
(debug:print-error 0 *default-log-port* "Missing target, must specify target for -kill-rerun with -target <target name>")
(exit 1))
((not runname-patt)
(debug:print-error 0 *default-log-port* "Missing runname, must specify runname for -kill-rerun with -runname <run name>")
(exit 1))
|
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
|
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(db-host (assoc/default 'db-host cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(state (args:get-arg ":state"))
(status (args:get-arg ":status"))
(target (args:get-arg "-target"))
(toppath (assoc/default 'toppath cmdinfo)))
(change-directory toppath)
(if (not target)
(begin
(debug:print-error 0 *default-log-port* "-target is required.")
(exit 1)))
(if (not (launch:setup))
|
|
>
|
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
|
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(db-host (assoc/default 'db-host cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(state (args:get-arg ":state"))
(status (args:get-arg ":status"))
;;(target (args:get-arg "-target"))
(target (common:args-get-target))
(toppath (assoc/default 'toppath cmdinfo)))
(change-directory toppath)
(if (not target)
(begin
(debug:print-error 0 *default-log-port* "-target is required.")
(exit 1)))
(if (not (launch:setup))
|