Overview
Comment: | Improvements to exclusive mode (but it still isn't working quite right). Factored clean-cache into a reusable function and called it also in -rerun*. Reduced number of server files to analyze. This may reduce the probability of a runaway server situation. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64 |
Files: | files | file ages | folders |
SHA1: |
0f50a21b4466d664a42f0696909aaa83 |
User & Date: | matt on 2017-03-27 12:05:27 |
Other Links: | branch diff | manifest | tags |
Context
2017-03-27
| ||
12:41 | prereq proc is supposed to return test records, not test names. check-in: 2b9e485b7f user: matt tags: v1.64 | |
12:05 | Improvements to exclusive mode (but it still isn't working quite right). Factored clean-cache into a reusable function and called it also in -rerun*. Reduced number of server files to analyze. This may reduce the probability of a runaway server situation. check-in: 0f50a21b44 user: matt tags: v1.64 | |
00:59 | Clone always for fossil sensing. Need additional logic otherwise check-in: dc0c36c096 user: matt tags: v1.64 | |
Changes
Modified db.scm from [c59ad9ec2a] to [2e4fa26f31].
︙ | ︙ | |||
3863 3864 3865 3866 3867 3868 3869 | ;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED) ;; mode 'toplevel means that tests must be COMPLETED only ;; mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]] ;; mode 'exclusive means this test/item cannot run if the same test/item is LAUNCHED,REMOTEHOSTSTART or RUNNING ;; ;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode) (define (db:get-prereqs-not-met dbstruct run-id waitons ref-test-name ref-item-path mode itemmaps) ;; #!key (mode '(normal))(itemmap #f)) | > | | | | | | > > > | > | | > | 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 | ;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED) ;; mode 'toplevel means that tests must be COMPLETED only ;; mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]] ;; mode 'exclusive means this test/item cannot run if the same test/item is LAUNCHED,REMOTEHOSTSTART or RUNNING ;; ;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode) (define (db:get-prereqs-not-met dbstruct run-id waitons ref-test-name ref-item-path mode itemmaps) ;; #!key (mode '(normal))(itemmap #f)) (append (if (member 'exclusive mode) (let ((running-tests (db:get-tests-for-run dbstruct #f ;; run-id of #f means for all runs. (if (string=? ref-item-path "") ;; testpatt ref-test-name (conc ref-test-name "/" ref-item-path)) '("LAUNCHED" "REMOTEHOSTSTART" "RUNNING") ;; states '() ;; statuses #f ;; offset #f ;; limit #f ;; not-in #f ;; sort by #f ;; sort order 'shortlist ;; query type 0 ;; last update, beginning of time .... #f ;; mode ))) (map db:test-get-testname running-tests)) '()) (if (or (not waitons) (null? waitons)) '() (let* ((unmet-pre-reqs '()) (result '())) (for-each (lambda (waitontest-name) |
︙ | ︙ |
Modified megatest.scm from [9b23a235c5] to [164cc6d2b1].
︙ | ︙ | |||
531 532 533 534 535 536 537 | (source-db (args:get-arg "-source-db"))) (db:cache-for-read-only source-db target-db) (set! *didsomething* #t))) ;; handle a clean-cache request as early as possible ;; (if (args:get-arg "-clean-cache") | | < | < < < < < < < < < < < < < < < < < < < < < | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 | (source-db (args:get-arg "-source-db"))) (db:cache-for-read-only source-db target-db) (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 (getenv "MT_TARGET")(args:get-arg "-runname" toppath)))) (if (args:get-arg "-env2file") (begin (save-environment-as-files (args:get-arg "-env2file")) (set! *didsomething* #t))) (if (args:get-arg "-list-disks") |
︙ | ︙ | |||
1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 | (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") state: states ;; status: statuses new-state-status: "NOT_STARTED,n/a") (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") ;; state: states status: statuses new-state-status: "NOT_STARTED,n/a"))) ;; RERUN ALL (if (args:get-arg "-rerun-all") ;; first set states/statuses correct (begin (hash-table-set! args:arg-hash "-preclean" #t) (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") state: #f ;; status: statuses new-state-status: "NOT_STARTED,n/a") (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") ;; state: states status: #f new-state-status: "NOT_STARTED,n/a"))) | > > | 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 | (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") state: states ;; status: statuses new-state-status: "NOT_STARTED,n/a") (runs:clean-cache target runname *toppath*) (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") ;; state: states status: statuses new-state-status: "NOT_STARTED,n/a"))) ;; RERUN ALL (if (args:get-arg "-rerun-all") ;; first set states/statuses correct (begin (hash-table-set! args:arg-hash "-preclean" #t) (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") state: #f ;; status: statuses new-state-status: "NOT_STARTED,n/a") (runs:clean-cache target runname *toppath*) (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") ;; state: states status: #f new-state-status: "NOT_STARTED,n/a"))) |
︙ | ︙ |
Modified mtut.scm from [3c13ebe524] to [12d335b5eb].
︙ | ︙ | |||
143 144 145 146 147 148 149 150 151 152 153 154 155 156 | ("--help" . #f) ("-manual" . #f) ("-version" . #f) ;; misc ("-repl" . #f) ("-immediate" . I) ("-preclean" . r) )) ;; alist to map actions to old megatest commands (define *action-keys* '((run . "-run") (sync . "") (archive . "-archive") | > | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | ("--help" . #f) ("-manual" . #f) ("-version" . #f) ;; misc ("-repl" . #f) ("-immediate" . I) ("-preclean" . r) ("-rerun-all" . u) )) ;; alist to map actions to old megatest commands (define *action-keys* '((run . "-run") (sync . "") (archive . "-archive") |
︙ | ︙ | |||
509 510 511 512 513 514 515 | (if (good-val dbdest) `(("-sync-to" . ,dbdest)) '()) (if (good-val append-conf) `(("-append-config" . ,append-conf)) '()) (if (not (or mode-patt tag-expr)) `(("-testpatt" . "%")) '()) (if (or (not action) (equal? action "run")) | > | | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 | (if (good-val dbdest) `(("-sync-to" . ,dbdest)) '()) (if (good-val append-conf) `(("-append-config" . ,append-conf)) '()) (if (not (or mode-patt tag-expr)) `(("-testpatt" . "%")) '()) (if (or (not action) (equal? action "run")) `(("-preclean" . " ") ("-rerun-all" . " ")) ;; if run we *always* want preclean set, use single space as placeholder '()) ) sched))) (with-output-to-file (conc pktsdir "/" uuid ".pkt") (lambda () (print pkt)))))) |
︙ | ︙ |
Modified runs.scm from [ef2599179d] to [3b13aedef2].
︙ | ︙ | |||
2074 2075 2076 2077 2078 2079 2080 | (conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment) " "SELECT " (db:test-get-id new-testdat) ",category,variable,value,expected,tol,units,comment FROM test_data WHERE test_id=?;") (db:test-get-id testdat)))) )) prev-tests))) | > > > > > > > > > > > > > > > > > > > > > > > | 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 | (conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment) " "SELECT " (db:test-get-id new-testdat) ",category,variable,value,expected,tol,units,comment FROM test_data WHERE test_id=?;") (db:test-get-id testdat)))) )) prev-tests))) ;; clean cache files (define (runs:clean-cache target runname toppath) (if target (if runname (let* ((linktree (common:get-linktree)) ;; (if toppath (configf:lookup *configdat* "setup" "linktree"))) (runtop (conc linktree "/" target "/" runname)) (files (if (file-exists? runtop) (append (glob (conc runtop "/.megatest*")) (glob (conc runtop "/.runconfig*"))) '()))) (if (null? files) (debug:print-info 0 *default-log-port* "No cached megatest or runconfigs files found. None removed.") (begin (debug:print-info 0 *default-log-port* "Removing cached files:\n " (string-intersperse files "\n ")) (for-each (lambda (f) (handle-exceptions exn (debug:print 0 *default-log-port* "WARNING: Failed to remove file " f) (delete-file f))) files)))) (debug:print-error 0 *default-log-port* "-clean-cache requires -runname.")) (debug:print-error 0 *default-log-port* "-clean-cache requires -target or -reqtarg"))) |
Modified server.scm from [2e218ee65f] to [34ba33b083].
︙ | ︙ | |||
190 191 192 193 194 195 196 | (res '())) (let* ((mod-time (handle-exceptions exn (current-seconds) ;; 0 (file-modification-time hed))) ;; default to *very* old so log gets ignored if deleted (down-time (- (current-seconds) mod-time)) (serv-dat (if (or (< num-serv-logs 10) | | | | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 | (res '())) (let* ((mod-time (handle-exceptions exn (current-seconds) ;; 0 (file-modification-time hed))) ;; default to *very* old so log gets ignored if deleted (down-time (- (current-seconds) mod-time)) (serv-dat (if (or (< num-serv-logs 10) (< down-time 900)) ;; day-seconds)) (server:logf-get-start-info hed) '())) ;; don't waste time processing server files not touched in the 15 minutes if there are more than ten servers to look at (serv-rec (cons mod-time serv-dat)) (fmatch (string-match fname-rx hed)) (pid (if fmatch (string->number (list-ref fmatch 2)) #f)) (new-res (if (null? serv-dat) res (cons (append serv-rec (list pid)) res)))) (if (null? tal) |
︙ | ︙ |