Overview
Comment: | killrun feature passes killrun test |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-killrun |
Files: | files | file ages | folders |
SHA1: |
900b334740ad45bcbcfc7421e0703a51 |
User & Date: | bjbarcla on 2019-01-30 14:49:57 |
Other Links: | branch diff | manifest | tags |
Context
2019-01-30
| ||
15:07 | added kill-run action to mtutil Leaf check-in: 017981efcd user: bjbarcla tags: v1.65-killrun | |
14:49 | killrun feature passes killrun test check-in: 900b334740 user: bjbarcla tags: v1.65-killrun | |
2019-01-29
| ||
00:36 | wip check-in: d9e675ce75 user: bb tags: v1.65-killrun | |
Changes
Modified megatest.scm from [3b556aba2a] to [85417a9093].
︙ | ︙ | |||
290 291 292 293 294 295 296 | "-itempatt" "-setlog" "-set-toplog" "-runstep" "-logpro" "-m" "-rerun" | | | 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" |
︙ | ︙ | |||
403 404 405 406 407 408 409 410 411 412 413 414 415 416 | ;; 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" "-keep-records" ;; use with -remove-runs to remove only the run data "-rebuild-db" "-cleanup-db" "-rollup" "-update-meta" "-create-megatest-area" "-mark-incompletes" | > | 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" |
︙ | ︙ | |||
1038 1039 1040 1041 1042 1043 1044 | ((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)) | | | 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 | ((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 (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)) |
︙ | ︙ | |||
1065 1066 1067 1068 1069 1070 1071 | (set! *didsomething* #t))))) (if (args:get-arg "-kill-runs") (general-run-call "-kill-runs" "kill runs" (lambda (target runname keys keyvals) | | > > > > > > > > > | 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 | (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") |
︙ | ︙ |
Modified runs.scm from [7e8b238a84] to [82f0950e7f].
︙ | ︙ | |||
2021 2022 2023 2024 2025 2026 2027 | (states (if state (string-split state ",") '())) (statuses (if status (string-split status ",") '())) (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f))) (rp-mutex (make-mutex)) (bup-mutex (make-mutex)) (keep-records (args:get-arg "-keep-records"))) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode". | | | 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 | (states (if state (string-split state ",") '())) (statuses (if status (string-split status ",") '())) (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f))) (rp-mutex (make-mutex)) (bup-mutex (make-mutex)) (keep-records (args:get-arg "-keep-records"))) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode". (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs)) (dbfile (conc *toppath* "/megatest.db")) (readonly-mode (not (file-write-access? dbfile)))) (when (and readonly-mode (member action write-access-actions)) (debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .") (exit 1))) |
︙ | ︙ | |||
2059 2060 2061 2062 2063 2064 2065 | (lasttpath "/does/not/exist/I/hope") (worker-thread #f)) (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header) (if (not (null? tests)) (begin (case action ((kill-runs) | < | < > < | 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 | (lasttpath "/does/not/exist/I/hope") (worker-thread #f)) (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header) (if (not (null? tests)) (begin (case action ((kill-runs) (tasks:kill-runner target run-name "%") (debug:print 1 *default-log-port* "Killing tests for run: " runkey " " (db:get-value-by-header run header "runname")) ) ((remove-runs) ;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10)) ;; seek and kill in flight -runtests with % as testpatt here ;; (if (equal? testpatt "%") (tasks:kill-runner target run-name testpatt) ;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt)) (debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))) ((set-state-status) ;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10)) (debug:print 1 *default-log-port* "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname"))) ((print-run) (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) |
︙ | ︙ | |||
2176 2177 2178 2179 2180 2181 2182 | ((started) ;; if last visit was within last second, sleep 1 second (if (< (- now last-visit) 1.0) (thread-sleep! 1.0)) (hash-table-set! backgrounded-remove-last-visit test-fulln (current-seconds)) ;; send to back of line, loop (let ((newtal (append tal (list test)))) | | | 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 | ((started) ;; if last visit was within last second, sleep 1 second (if (< (- now last-visit) 1.0) (thread-sleep! 1.0)) (hash-table-set! backgrounded-remove-last-visit test-fulln (current-seconds)) ;; send to back of line, loop (let ((newtal (append tal (list test)))) (loop (car newtal)(cdr newtal))) ) ((done) ;; drop this one; if remaining, loop, else finish (hash-table-set! backgrounded-remove-last-visit test-fulln (current-seconds)) (let ((subrun-remove-succeeded (hash-table-ref/default backgrounded-remove-result test-fulln 'exception))) (cond ((eq? subrun-remove-succeeded 'exception) |
︙ | ︙ | |||
2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 | (loop new-test-dat tal) (loop (car tal)(append tal (list new-test-dat))))) (begin (runs:remove-test-directory new-test-dat mode) ;; 'remove-all) (if (not (null? tal)) (loop (car tal)(cdr tal))))))) (rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id))) ((set-state-status) (let* ((new-state (car state-status)) (new-status (cadr state-status)) (test-id (db:test-get-id test)) (test-run-dir (db:test-get-rundir new-test-dat)) (has-subrun (and (subrun:subrun-test-initialized? test-run-dir) (not (subrun:subrun-removed? test-run-dir))))) | > > > > > > > > > > > > > > > > > > | 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 | (loop new-test-dat tal) (loop (car tal)(append tal (list new-test-dat))))) (begin (runs:remove-test-directory new-test-dat mode) ;; 'remove-all) (if (not (null? tal)) (loop (car tal)(cdr tal))))))) (rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id))) ((kill-runs) ;; RUNNING -> KILLREQ ;; LAUNCHED,RUNNING,REMOTEHOSTSTART -> NOT STARTED (cond ((and has-subrun (member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ"))) (common:send-thunk-to-background-thread (lambda () (let* ((subrun-remove-succeeded (subrun:kill-subrun run-dir keep-records))) #t))) (if (not (null? tal)) (loop (car tal)(cdr tal))) ) ((member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ")) (mt:test-set-state-status-by-id run-id (db:test-get-id test) "KILLREQ" "n/a" #f) (if (not (null? tal)) (loop (car tal)(cdr tal))) ))) ((set-state-status) (let* ((new-state (car state-status)) (new-status (cadr state-status)) (test-id (db:test-get-id test)) (test-run-dir (db:test-get-rundir new-test-dat)) (has-subrun (and (subrun:subrun-test-initialized? test-run-dir) (not (subrun:subrun-removed? test-run-dir))))) |
︙ | ︙ |
Modified subrun.scm from [bb7061fde4] to [ad3bd444b3].
︙ | ︙ | |||
116 117 118 119 120 121 122 123 124 125 126 127 128 129 | (subrun:exec-sub-megatest test-run-dir action-switches-str "remove"))) (if remove-result (begin (subrun:set-subrun-removed test-run-dir) #t) #f)) #t)) (define (subrun:launch-cmd test-run-dir) (if (subrun:subrun-removed? test-run-dir) (subrun:unset-subrun-removed test-run-dir)) (let* ((log-prefix "run") (switches (subrun:selector+log-switches test-run-dir log-prefix)) | > > > > > > > > > | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | (subrun:exec-sub-megatest test-run-dir action-switches-str "remove"))) (if remove-result (begin (subrun:set-subrun-removed test-run-dir) #t) #f)) #t)) (define (subrun:kill-subrun test-run-dir ) (if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir)) (let* ((action-switches-str (conc "-kill-runs" )) (kill-result (subrun:exec-sub-megatest test-run-dir action-switches-str "kill"))) kill-result) #t)) (define (subrun:launch-cmd test-run-dir) (if (subrun:subrun-removed? test-run-dir) (subrun:unset-subrun-removed test-run-dir)) (let* ((log-prefix "run") (switches (subrun:selector+log-switches test-run-dir log-prefix)) |
︙ | ︙ |