︙ | | |
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
+
|
-version : print megatest version (currently " megatest-version ")
Launching and managing runs
-run : run all tests or as specified by -testpatt
-remove-runs : remove the data for a run, requires -runname and -testpatt
Optionally use :state and :status, use -keep-records to remove only
the run data.
-kill-runs : kill an existing run (all incomplete tests marked abort, launched marked not-started)
-set-state-status X,Y : set state to X and status to Y, requires controls per -remove-runs
-rerun FAIL,WARN... : force re-run for tests with specificed status(s)
-rerun-clean : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
and then run the specified testpatt with -preclean
-rerun-all : set all tests to NOT_STARTED,n/a and run with -preclean
-lock : lock run specified by target and runname
-unlock : unlock run specified by target and runname
|
︙ | | |
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
+
|
"-itempatt"
"-setlog"
"-set-toplog"
"-runstep"
"-logpro"
"-m"
"-rerun"
"-days"
"-rename-run"
"-to"
;; values and messages
":category"
":variable"
":value"
|
︙ | | |
401
402
403
404
405
406
407
408
409
410
411
412
413
414
|
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
|
+
|
;; queries
"-test-paths" ;; get path(s) to a test, ordered by youngest first
"-runall" ;; run all tests, respects -testpatt, defaults to %
"-run" ;; alias for -runall
"-remove-runs"
"-kill-runs"
"-keep-records" ;; use with -remove-runs to remove only the run data
"-rebuild-db"
"-cleanup-db"
"-rollup"
"-update-meta"
"-create-megatest-area"
"-mark-incompletes"
|
︙ | | |
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
|
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
|
-
+
|
(printf "Sending signal/term to ~A\n" pid)
(process-signal pid signal/term))))))
(process:children #f))
(original-exit exit-code)))))
;; for some switches always print the command to stderr
;;
(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status")
(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-kill-runs")
(debug:print 0 *default-log-port* (string-intersperse (argv) " ")))
;; some switches imply homehost. Exit here if not on homehost
;;
(let ((homehost-required (list "-cleanup-db" "-server")))
(if (apply args:any? homehost-required)
(if (not (common:on-homehost?))
|
︙ | | |
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
|
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
((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")
(exit 2))
((not (args:get-arg "-testpatt"))
((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
"-kill-runs"
"kill runs"
(lambda (target runname keys keyvals)
(operate-on 'kill-runs mode: #f)
(operate-on 'set-state-status
state: (common:args-get-state)
status: (common:args-get-status)
new-state-status: (args:get-arg "-set-state-status")
mode: #f) ;; kill-req on running,launched,remotehoststart things,
)))
(if (args:get-arg "-remove-runs")
(general-run-call
"-remove-runs"
"remove runs"
(lambda (target runname keys keyvals)
(operate-on 'remove-runs mode: (if (args:get-arg "-keep-records")
|
︙ | | |