Changes In Branch v1.65-cpick01 Excluding Merge-Ins
This is equivalent to a diff from 367ffc5bdf to ac1b58436b
2020-05-31
| ||
21:19 | Cherrypick 0495fb 2a858 from v1.65-broken. Better support for utilizing MT_ vars to fill defaults when -target, -testpatt, etc. are not specified check-in: 74a0e98868 user: mrwellan tags: v1.65 | |
21:16 | Cherrypick 0a9e69 aa2998 63e558 b487e8 e28be4 50237f 64aa934, passes all. Closed-Leaf check-in: ac1b58436b user: mrwellan tags: v1.65-cpick01 | |
21:01 | Cherrypick ea8c3e 5b7f0 7ff937 18da8b, cpick03, all pass. check-in: f471242dd5 user: mrwellan tags: v1.65-cpick01 | |
19:49 | Cherrypick 0495fb 2a858 from v1.65-broken. check-in: fb39cefbf1 user: mrwellan tags: v1.65-cpick01 | |
16:48 | Pulled in changes only related to fixes from newview branch Closed-Leaf check-in: 4d6ba57051 user: matt tags: v1.65-oops-n | |
2020-05-27
| ||
12:46 | Create new branch named "v1.65-junit-xml" check-in: 473d6eaf82 user: pjhatwal tags: v1.65-junit-xml | |
2020-04-20
| ||
21:49 | Merged newview work into v1.65 to minimize divergences check-in: 3b86fd8d4c user: mrwellan tags: v1.65-broken | |
2020-04-06
| ||
16:21 | Merged in v1.65 check-in: db55d34798 user: mrwellan tags: v1.65-newview | |
2020-03-10
| ||
15:14 | merged branch check-in: 367ffc5bdf user: mmgraham tags: v1.65, v1.6545 | |
15:14 | Updated Version check-in: e1e57863ea user: jmoon18 tags: v1.65 | |
2020-03-05
| ||
16:45 | Fixed the removal of test and run directories. Leaf check-in: e24a447e39 user: mmgraham tags: v1.65-martins-stuff | |
Modified archive.scm from [618f9a591e] to [212cc6c596].
︙ | ︙ | |||
88 89 90 91 92 93 94 | (hash-table-ref blockid-cache key) (let* ((pscript (configf:lookup *configdat* "archive" "pathscript")) (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name)) (apath (if pscript (handle-exceptions exn (begin | | | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | (hash-table-ref blockid-cache key) (let* ((pscript (configf:lookup *configdat* "archive" "pathscript")) (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name)) (apath (if pscript (handle-exceptions exn (begin (debug:print 0 *default-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly.") (exit 1)) (with-input-from-pipe pscript-cmd read-line)) #f)) ;; this is the user-calculated archive path (adisks (archive:get-archive-disks)) (best-disk (common:get-disk-with-most-free-space adisks dneeded))) |
︙ | ︙ | |||
114 115 116 117 118 119 120 | (archive-path (conc bdisk-path "/" archive-name)) (block-id (rmt:archive-register-block-name bdisk-id archive-path))) ;; (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key))) (if block-id ;; (and block-id allocation-id) (let ((res (cons block-id archive-path))) (hash-table-set! blockid-cache key res) res) | > > | > > | < | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | (archive-path (conc bdisk-path "/" archive-name)) (block-id (rmt:archive-register-block-name bdisk-id archive-path))) ;; (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key))) (if block-id ;; (and block-id allocation-id) (let ((res (cons block-id archive-path))) (hash-table-set! blockid-cache key res) res) (begin (debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", archive-path=" archive-path) #f))) (begin (debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", block-id=" block-id) #f)))))) ;; no best disk found ;; archive - run bup ;; ;; 1. create the bup dir if not exists ;; 2. start the du of each directory ;; 3. gen index ;; 4. save |
︙ | ︙ | |||
244 245 246 247 248 249 250 | (lambda (test-base) (let* ((disk-group (hash-table-ref disk-groups test-base)) (arch-group (hash-table-ref arch-groups test-base)) (arch-info (car arch-group)) ;; don't know yet how this will work, can I get more than one possibility? (archive-id (car arch-info)) (archive-dir (cdr arch-info))) (debug:print 0 *default-log-port* "Processing disk-group " test-base) | | > > > > > > > > > | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 | (lambda (test-base) (let* ((disk-group (hash-table-ref disk-groups test-base)) (arch-group (hash-table-ref arch-groups test-base)) (arch-info (car arch-group)) ;; don't know yet how this will work, can I get more than one possibility? (archive-id (car arch-info)) (archive-dir (cdr arch-info))) (debug:print 0 *default-log-port* "Processing disk-group " test-base) (let* ((test-paths-in (hash-table-ref disk-groups test-base)) (test-paths (if (args:get-arg "-include") (let ((subpaths (string-split (args:get-arg "-include") ","))) (apply append (map (lambda (p) (map (lambda (subp) (conc p "/" subp)) subpaths)) test-paths-in))) test-paths-in))) (if (not (common:file-exists? archive-dir)) (create-directory archive-dir #t)) (case archiver ((bup) ;; Archive using bup (let* ((bup-init-params (list "-d" archive-dir "init")) (bup-index-params (append (list "-d" archive-dir "index") test-paths)) (bup-save-params (append (list "-d" archive-dir "save" ;; (conc "--strip-path=" linktree) |
︙ | ︙ | |||
341 342 343 344 345 346 347 | (mutex-unlock! rp-mutex) (new-test-physical-path (conc best-disk "/" test-partial-path)) (archive-block-id (db:test-get-archived test-dat)) (archive-block-info (rmt:test-get-archive-block-info archive-block-id)) (archive-path (if (vector? archive-block-info) (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info #f)) ;; no archive found? | | > > > | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 | (mutex-unlock! rp-mutex) (new-test-physical-path (conc best-disk "/" test-partial-path)) (archive-block-id (db:test-get-archived test-dat)) (archive-block-info (rmt:test-get-archive-block-info archive-block-id)) (archive-path (if (vector? archive-block-info) (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info #f)) ;; no archive found? (archive-internal-path (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path)) (include-paths (args:get-arg "-include")) (exclude-pattern (args:get-arg "-exclude-rx")) (exclude-file (args:get-arg "-exclude-rx-from"))) ;; some sanity checks, move an existing path out of the way - iif it is not a toplevel with children ;; (if (and (not toplevel/children) ;; special handling needed for toplevel with children prev-test-physical-path (common:file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in? (let* ((base (pathname-directory prev-test-physical-path)) |
︙ | ︙ | |||
384 385 386 387 388 389 390 | (debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path) ;; (mutex-lock! bup-mutex) (run-n-wait bup-exe params: bup-restore-params print-cmd: #f) ;; (mutex-unlock! bup-mutex) (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f))) (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id)))) (filter vector? tests)))) | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 | (debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path) ;; (mutex-lock! bup-mutex) (run-n-wait bup-exe params: bup-restore-params print-cmd: #f) ;; (mutex-unlock! bup-mutex) (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f))) (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id)))) (filter vector? tests)))) (define (common:get-youngest-test tests) (if (null? tests) #f (let ((res #f)) (for-each (lambda (test-dat) (let ((event-time (db:test-get-event_time test-dat))) (if (or (not res) (> event-time (db:test-get-event_time res))) (set! res test-dat)))) tests) res))) ;; from an archive get a specific path - works ONLY with bup for now ;; (define (archive:bup-get-data archive-command run-id-in run-name-in tests rp-mutex bup-mutex) (if (null? tests) (debug:print-info 0 *default-log-port* "get-data called with no matching tests to operate on.") (let* ((bup-exe (or (configf:lookup *configdat* "archive" "bup") "bup")) (linktree (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))) ;; (test-dat (common:get-youngest-test tests)) (destpath (args:get-arg "-dest"))) (cond ((null? tests) (debug:print-error 0 *default-log-port* "No test matching provided target, runname pattern and test pattern found.")) ((file-exists? destpath) (debug:print-error 0 *default-log-port* "Destination path alread exists! Please remove it before running get.")) (else (let loop ((rem-tests tests)) (let* ((test-dat (common:get-youngest-test rem-tests)) (item-path (db:test-get-item-path test-dat)) (test-name (db:test-get-testname test-dat)) (test-id (db:test-get-id test-dat)) (run-id (db:test-get-run_id test-dat)) (run-name (rmt:get-run-name-from-id run-id)) (keyvals (rmt:get-key-val-pairs run-id)) (target (string-intersperse (map cadr keyvals) "/")) (toplevel/children (and (db:test-get-is-toplevel test-dat) (> (rmt:test-toplevel-num-items run-id test-name) 0))) (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path))) ;; note the trailing slash to get the dir inspite of it being a link (test-path (conc linktree "/" test-partial-path)) (archive-block-id (db:test-get-archived test-dat)) (archive-block-info (rmt:test-get-archive-block-info archive-block-id)) (archive-path (if (vector? archive-block-info) (vector-ref archive-block-info 2) #f)) (archive-internal-path (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path)) (include-paths (args:get-arg "-include")) (exclude-pattern (args:get-arg "-exclude-rx")) (exclude-file (args:get-arg "-exclude-rx-from"))) (if (and archive-path ;; no point in proceeding if there is no actual archive (not toplevel/children)) (begin (let* ((bup-restore-params (append (list "-d" archive-path "restore" "-C" (or destpath "data")) ;; " " ;; What is the empty string for? (if include-paths (map (lambda (p) (conc archive-internal-path "/" p)) (string-split include-paths ",")) (list archive-internal-path))))) (debug:print-info 0 *default-log-port* "Restoring archived data to " (or destpath "data") " from archive in " archive-path " ... " archive-internal-path) (run-n-wait bup-exe params: bup-restore-params print-cmd: #t))) (let ((new-rem-tests (filter (lambda (tdat) (or (not (eq? (db:test-get-id tdat) test-id)) (not (eq? (db:test-get-run_id tdat) run-id)))) rem-tests) )) (debug:print-info 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id ", skipping.") (if (null? new-rem-tests) (begin (debug:print-info 0 *default-log-port* "No archives found for " target "/" run-name "...") #f) (loop new-rem-tests))))))))))) |
Modified common.scm from [4d4a2441c8] to [e0587bf118].
︙ | ︙ | |||
482 483 484 485 486 487 488 | (max-allowed (string->number (or (configf:lookup *configdat* "setup" "max-logfiles") "300")))) ;; name -> age (if (not (directory-exists? "logs"))(create-directory "logs")) (directory-fold (lambda (file rem) (handle-exceptions exn (begin | | | | > | 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 | (max-allowed (string->number (or (configf:lookup *configdat* "setup" "max-logfiles") "300")))) ;; name -> age (if (not (directory-exists? "logs"))(create-directory "logs")) (directory-fold (lambda (file rem) (handle-exceptions exn (begin (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore.") (debug:print 2 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) ;; (print-call-chain (current-error-port)) ;; ) (let* ((fullname (conc "logs/" file)) (mod-time (file-modification-time fullname)) (file-age (- (current-seconds) mod-time))) (hash-table-set! all-files file mod-time) (if (or (and (string-match "^.*.log" file) (> (file-size fullname) 200000)) (and (string-match "^server-.*.log" file) |
︙ | ︙ | |||
1195 1196 1197 1198 1199 1200 1201 | ;; use bash to expand a glob. Does NOT handle paths with spaces! ;; (define (common:bash-glob instr) (string-split (with-input-from-pipe (conc "/bin/bash -c \"echo " instr "\"") | | > > > > > > > > > > > > | 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 | ;; use bash to expand a glob. Does NOT handle paths with spaces! ;; (define (common:bash-glob instr) (string-split (with-input-from-pipe (conc "/bin/bash -c \"echo " instr "\"") read-line))) ;;====================================================================== ;; Some safety net stuff ;;====================================================================== ;; return input if it is a list or return null (define (common:list-or-null inlst #!key (ovrd #f)(message #f)) (if (list? inlst) inlst (begin (if message (debug:print-error 0 *default-log-port* message)) (or ovrd '())))) ;;====================================================================== ;; T A R G E T S , S T A T E , S T A T U S , ;; R U N N A M E A N D T E S T P A T T ;;====================================================================== ;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t)))) |
︙ | ︙ | |||
1700 1701 1702 1703 1704 1705 1706 | ;; (set! cpu-load newval)))))) ;; (car load-res)) ;; cpu-load)) ;; get values from cached info from dropping file in logs dir ;; e.g. key is host and dtype is normalized-load ;; | | | | 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 | ;; (set! cpu-load newval)))))) ;; (car load-res)) ;; cpu-load)) ;; get values from cached info from dropping file in logs dir ;; e.g. key is host and dtype is normalized-load ;; (define (common:get-cached-info key dtype #!key (age 10)) (if *toppath* (let* ((fullpath (conc *toppath* "/.sysdata/" key "-" dtype ".log"))) (if (and (file-exists? fullpath) (file-read-access? fullpath)) (handle-exceptions exn #f (debug:print 2 *default-log-port* "reading file " fullpath) (let ((real-age (- (current-seconds)(file-change-time fullpath)))) (if (< real-age age) (with-input-from-file fullpath read) (begin (debug:print-info 2 *default-log-port* "file " fullpath " is too old (" real-age" seconds) to trust, skipping reading it") #f)))) (begin (debug:print 2 *default-log-port* "not reading file " fullpath) #f))) #f)) (define (common:write-cached-info key dtype dat) |
︙ | ︙ | |||
1979 1980 1981 1982 1983 1984 1985 | numcpu) (read-line)))))) (result (if remote-host (with-input-from-pipe (conc "ssh " remote-host " cat /proc/cpuinfo") proc) (with-input-from-file "/proc/cpuinfo" proc)))) | > > | | 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 | numcpu) (read-line)))))) (result (if remote-host (with-input-from-pipe (conc "ssh " remote-host " cat /proc/cpuinfo") proc) (with-input-from-file "/proc/cpuinfo" proc)))) (if (and (number? result) (> result 0)) (common:write-cached-info actual-host "num-cpus" result)) result)))) ;; wait for normalized cpu load to drop below maxload ;; (define (common:wait-for-normalized-load maxload msg remote-host #!optional (rem-tries 5)) (let ((num-cpus (common:get-num-cpus remote-host))) (if num-cpus |
︙ | ︙ | |||
2009 2010 2011 2012 2013 2014 2015 | maxload-in (max maxload-in 0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME? (first (car loadavg)) (next (cadr loadavg)) (adjload (* maxload (max 1 numcpus))) ;; possible bug where numcpus (or could be maxload) is zero, crude fallback is to at least use 1 (loadjmp (- first next)) (adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)(/ (- 1000 count) 10) waitdelay) (- first adjload) )) )));; add some randomness to the time to break any alignment where netbatch dumps many jobs to machines simultaneously | > > | | | 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 | maxload-in (max maxload-in 0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME? (first (car loadavg)) (next (cadr loadavg)) (adjload (* maxload (max 1 numcpus))) ;; possible bug where numcpus (or could be maxload) is zero, crude fallback is to at least use 1 (loadjmp (- first next)) (adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)(/ (- 1000 count) 10) waitdelay) (- first adjload) )) )));; add some randomness to the time to break any alignment where netbatch dumps many jobs to machines simultaneously ;; let's let the user know once in a long while that load checking is happening but not constantly report it (if (> (random 100) 75) ;; about 25% of the time (debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload ", load: " first ", adjload: " adjload ", loadjmp: " loadjmp)) (cond ((and (> first adjload) (> count 0)) (debug:print-info 0 *default-log-port* "server start delayed " adjwait " seconds due to load " first " exceeding max of " adjload " on server " (or remote-host (get-host-name)) " (normalized load-limit: " maxload ") " (if msg msg "")) (thread-sleep! adjwait) (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host)) ((and (> loadjmp numcpus) |
︙ | ︙ |
Modified db.scm from [4dafe820e6] to [17795efac6].
︙ | ︙ | |||
1462 1463 1464 1465 1466 1467 1468 | (sqlite3:for-each-row (lambda (id) (set! res id)) db "SELECT id FROM archive_blocks WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path) (if res ;; record exists, update du if applicable and return res | < | | < | | 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 | (sqlite3:for-each-row (lambda (id) (set! res id)) db "SELECT id FROM archive_blocks WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path) (if res ;; record exists, update du if applicable and return res (if du (sqlite3:execute db "UPDATE archive_blocks SET last_du=?,last_du_time=(strftime('%s','now')) WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path du)) (begin (sqlite3:execute db "INSERT OR REPLACE INTO archive_blocks (archive_disk_id,disk_path,last_du) VALUES (?,?,?);" bdisk-id archive-path (or du 0)) (set! res (db:archive-register-block-name dbstruct bdisk-id archive-path du: du)))) (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat) res)) ;; The "archived" field in tests is overloaded; 0 = not archived, > 0 archived in block with given id ;; (define (db:test-set-archive-block-id dbstruct run-id test-id archive-block-id) |
︙ | ︙ |
Modified docs/manual/howto.txt from [b66065dad3] to [5266978039].
︙ | ︙ | |||
66 67 68 69 70 71 72 73 74 75 76 77 78 79 | ---------------- Hint: You can browse the archive using bup commands directly. ---------------- bup -d /path/to/bup/archive ftp ---------------- Submit jobs to Host Types based on Test Name ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .In megatest.config ------------------------ [host-types] | > > > > > > > > > > > > > > > > > | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | ---------------- Hint: You can browse the archive using bup commands directly. ---------------- bup -d /path/to/bup/archive ftp ---------------- Pass Data from Test to Test ~~~~~~~~~~~~~~~~~~~~~~~~~~~ .To save the data call archive save within your test: ---------------- megatest -archive save ---------------- .To retrieve the data call archive get using patterns as needed ---------------- # Put the retrieved data into /tmp DESTPATH=/tmp/$USER/$MT_TARGET/$MT_RUN_NAME/$MT_TESTNAME/$MT_ITEMPATH/my_data mkdir -p $DESTPATH megatest -archive get -runname % -dest $DESTPATH ---------------- Submit jobs to Host Types based on Test Name ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .In megatest.config ------------------------ [host-types] |
︙ | ︙ |
Modified docs/manual/megatest_manual.html from [2cca53be9f] to [dd1dac404b].
︙ | ︙ | |||
1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 | <div class="paragraph"><p>Hint: You can browse the archive using bup commands directly.</p></div> <div class="listingblock"> <div class="content monospaced"> <pre>bup -d /path/to/bup/archive ftp</pre> </div></div> </div> </div> </div> <div class="sect2"> <h3 id="_submit_jobs_to_host_types_based_on_test_name">Submit jobs to Host Types based on Test Name</h3> <div class="listingblock"> <div class="title">In megatest.config</div> <div class="content monospaced"> <pre>[host-types] | > > > > > > > > > > > > > > > > | 1450 1451 1452 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 | <div class="paragraph"><p>Hint: You can browse the archive using bup commands directly.</p></div> <div class="listingblock"> <div class="content monospaced"> <pre>bup -d /path/to/bup/archive ftp</pre> </div></div> </div> </div> </div> <div class="sect2"> <h3 id="_pass_data_from_test_to_test">Pass Data from Test to Test</h3> <div class="listingblock"> <div class="title">To save the data call archive save within your test:</div> <div class="content monospaced"> <pre>megatest -archive save</pre> </div></div> <div class="listingblock"> <div class="title">To retrieve the data call archive get using patterns as needed</div> <div class="content monospaced"> <pre># Put the retrieved data into /tmp DESTPATH=/tmp/$USER/$MT_TARGET/$MT_RUN_NAME/$MT_TESTNAME/$MT_ITEMPATH/my_data mkdir -p $DESTPATH megatest -archive get -runname % -dest $DESTPATH</pre> </div></div> </div> <div class="sect2"> <h3 id="_submit_jobs_to_host_types_based_on_test_name">Submit jobs to Host Types based on Test Name</h3> <div class="listingblock"> <div class="title">In megatest.config</div> <div class="content monospaced"> <pre>[host-types] |
︙ | ︙ | |||
2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 | </div></div> <div class="paragraph"><p>To transfer the environment to the next step you can do the following:</p></div> <div class="listingblock"> <div class="title">Propagate environment to next step</div> <div class="content monospaced"> <pre>$MT_MEGATEST -env2file .ezsteps/${stepname}</pre> </div></div> <div class="listingblock"> <div class="title">Full example with ezsteps, logpro rules, scripts etc.</div> <div class="content monospaced"> <pre># You can include a common file # [include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc] | > > > > > > > > > > > > > > > > > > > | 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 | </div></div> <div class="paragraph"><p>To transfer the environment to the next step you can do the following:</p></div> <div class="listingblock"> <div class="title">Propagate environment to next step</div> <div class="content monospaced"> <pre>$MT_MEGATEST -env2file .ezsteps/${stepname}</pre> </div></div> </div> <div class="sect2"> <h3 id="_scripts">Scripts</h3> <div class="listingblock"> <div class="title">Specifying scripts inline (best used for only simple scripts)</div> <div class="content monospaced"> <pre>[scripts] loaddb #!/bin/bash sqlite3 $1 <<EOF .mode tabs .import $2 data .q EOF</pre> </div></div> <div class="paragraph"><p>The above snippet results in the creation of an executable script called "loaddb" in the test directory. NOTE: every line in the script must be prefixed with the exact same number of spaces. Lines beginning with a # will not work as expected. Currently you cannot indent intermediate lines.</p></div> <div class="listingblock"> <div class="title">Full example with ezsteps, logpro rules, scripts etc.</div> <div class="content monospaced"> <pre># You can include a common file # [include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc] |
︙ | ︙ | |||
3132 3133 3134 3135 3136 3137 3138 | </div> </div> </div> <div id="footnotes"><hr></div> <div id="footer"> <div id="footer-text"> Version 1.0<br> | | | 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 | </div> </div> </div> <div id="footnotes"><hr></div> <div id="footer"> <div id="footer-text"> Version 1.0<br> Last updated 2020-02-24 08:51:51 PST </div> </div> </body> </html> |
Modified docs/manual/reference.txt from [41ce966733] to [332bf8caed].
︙ | ︙ | |||
462 463 464 465 466 467 468 | -------------- Complex mapping example ~~~~~~~~~~~~~~~~~~~~~~~ | < < | 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 | -------------- Complex mapping example ~~~~~~~~~~~~~~~~~~~~~~~ // image::itemmap.png[] image::complex-itemmap.png[] We accomplish this by configuring the testconfigs of our tests C D and E as follows: .Testconfig for Test E has ---------------------- [requirements] waiton C |
︙ | ︙ | |||
512 513 514 515 516 517 518 | . Test A has no waitons. All waitons of all tests in full list have been processed. Full list is finalized. itemstable ~~~~~~~~~~ An alternative to defining items is the itemstable section. This lets you define the itempath in a table format rather than specifying components and relying on getting all permutations of those components. | < < < < | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 | . Test A has no waitons. All waitons of all tests in full list have been processed. Full list is finalized. itemstable ~~~~~~~~~~ An alternative to defining items is the itemstable section. This lets you define the itempath in a table format rather than specifying components and relying on getting all permutations of those components. Dynamic Flow Dependency Tree ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Autogeneration waiton list for dynamic flow dependency trees ------------------- [requirements] |
︙ | ︙ | |||
650 651 652 653 654 655 656 657 658 659 660 661 662 663 | To transfer the environment to the next step you can do the following: .Propagate environment to next step ---------------------------- $MT_MEGATEST -env2file .ezsteps/${stepname} ---------------------------- .Full example with ezsteps, logpro rules, scripts etc. ----------------- # You can include a common file # [include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc] # Use "var" for a scratch pad | > > > > > > > > > > > > > > > > > > > > | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 | To transfer the environment to the next step you can do the following: .Propagate environment to next step ---------------------------- $MT_MEGATEST -env2file .ezsteps/${stepname} ---------------------------- Scripts ~~~~~~~ .Specifying scripts inline (best used for only simple scripts) ---------------------------- [scripts] loaddb #!/bin/bash sqlite3 $1 <<EOF .mode tabs .import $2 data .q EOF ---------------------------- The above snippet results in the creation of an executable script called "loaddb" in the test directory. NOTE: every line in the script must be prefixed with the exact same number of spaces. Lines beginning with a # will not work as expected. Currently you cannot indent intermediate lines. .Full example with ezsteps, logpro rules, scripts etc. ----------------- # You can include a common file # [include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc] # Use "var" for a scratch pad |
︙ | ︙ |
Modified genexample.scm from [d3c1b1c11c] to [2597a6cc06].
︙ | ︙ | |||
154 155 156 157 158 159 160 | (print "[fields]") (map (lambda (k)(print k " TEXT")) keys) (print "") (print "[setup]") (print "# Adjust max_concurrent_jobs to limit how much you load your machines") (print "max_concurrent_jobs 50\n") (print "# This is your link path. Avoid moving it once set.") | | | | | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | (print "[fields]") (map (lambda (k)(print k " TEXT")) keys) (print "") (print "[setup]") (print "# Adjust max_concurrent_jobs to limit how much you load your machines") (print "max_concurrent_jobs 50\n") (print "# This is your link path. Avoid moving it once set.") (print "linktree " lntree) ;; (common:real-path lntree)) (print "\n# Job tools are more advanced ways to control how your jobs are launched") (print "[jobtools]\nuseshell yes\nlauncher nbfake\nmaxload 1.5\n") (print "# You can override environment variables for all your tests here") (print "[env-override]\nEXAMPLE_VAR example value\n") (print "# As you run more tests you may need to add additional disks, the names are arbitrary but must be unique") (print "[disks]\ndisk0 " firstd))) ;; (common:real-path firstd)))) (print "================== I'm now creating a runconfigs.config file for you with a default section. You can use this file to set variables for your tests based on the \"target\" (the combination of keys). |
︙ | ︙ | |||
193 194 195 196 197 198 199 | (print "# Override settings in ../runconfigs.config for user " (current-user-name) " here."))) ;; Now create a test and logpro file (print "================== You now have the basic common files for your megatest setup. Next run | | | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | (print "# Override settings in ../runconfigs.config for user " (current-user-name) " here."))) ;; Now create a test and logpro file (print "================== You now have the basic common files for your megatest setup. Next run \"megatest -create-test <testname>\" to create a test. Thank you for using Megatest. You can edit your config files and create tests in the " path " directory "))) |
︙ | ︙ |
Modified launch.scm from [6b5c8d69de] to [b881cd615c].
︙ | ︙ | |||
621 622 623 624 625 626 627 | (set-signal-handler! signal/int sighand) (set-signal-handler! signal/term sighand) ) ;; (set-signal-handler! signal/stop sighand) ;; Do not run the test if it is REMOVING, RUNNING, KILLREQ or REMOTEHOSTSTART, ;; Mark the test as REMOTEHOSTSTART *IMMEDIATELY* ;; | > | > > > > > > > | 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 | (set-signal-handler! signal/int sighand) (set-signal-handler! signal/term sighand) ) ;; (set-signal-handler! signal/stop sighand) ;; Do not run the test if it is REMOVING, RUNNING, KILLREQ or REMOTEHOSTSTART, ;; Mark the test as REMOTEHOSTSTART *IMMEDIATELY* ;; (let* ((test-info (let loop ((tries 0)) (let ((tinfo (rmt:get-test-info-by-id run-id test-id))) (if tinfo tinfo (if (> tries 5) #f (begin (thread-sleep! (+ 1 (* tries 10))) (loop (+ tries 1)))))))) (test-host (if test-info (db:test-get-host test-info) (begin (debug:print 0 *default-log-port* "ERROR: failed to find a record for test-id " test-id ", exiting.") (exit)))) (test-pid (db:test-get-process_id test-info))) (cond |
︙ | ︙ | |||
1122 1123 1124 1125 1126 1127 1128 | (set! toppath *toppath*) (if (not *toppath*) (begin (debug:print-error 0 *default-log-port* "you are not in a megatest area!") (exit 1))) (setenv "MT_RUN_AREA_HOME" *toppath*) ;; the seed read is done, now read runconfigs, cache it then read megatest.config one more time and cache it | | > | 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 | (set! toppath *toppath*) (if (not *toppath*) (begin (debug:print-error 0 *default-log-port* "you are not in a megatest area!") (exit 1))) (setenv "MT_RUN_AREA_HOME" *toppath*) ;; the seed read is done, now read runconfigs, cache it then read megatest.config one more time and cache it (let* ((keys (common:list-or-null (rmt:get-keys) message: "Failed to retrieve keys in launch.scm. Please report this to the developers.")) (key-vals (keys:target->keyval keys target)) (linktree (common:get-linktree)) ;; (or (getenv "MT_LINKTREE")(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))) ; (if *configdat* ; (configf:lookup *configdat* "setup" "linktree") ; (conc *toppath* "/lt")))) (second-pass (find-and-read-config mtconfig |
︙ | ︙ |
Modified megatest.scm from [7e6fcbd15f] to [4aeaf761b4].
︙ | ︙ | |||
224 225 226 227 228 229 230 | -refdb2dat refdb : convert refdb to sexp or to format specified by s-dumpmode formats: perl, ruby, sqlite3, csv (for csv the -o param will substitute %s for the sheet name in generating multiple sheets) -o : output file for refdb2dat (defaults to stdout) -archive cmd : archive runs specified by selectors to one of disks specified in the [archive-disks] section. | | > | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 | -refdb2dat refdb : convert refdb to sexp or to format specified by s-dumpmode formats: perl, ruby, sqlite3, csv (for csv the -o param will substitute %s for the sheet name in generating multiple sheets) -o : output file for refdb2dat (defaults to stdout) -archive cmd : archive runs specified by selectors to one of disks specified in the [archive-disks] section. cmd: keep-html, restore, save, save-remove, get (use -dest to set destination), -include path1,path2... to get or save specific files -generate-html : create a simple html dashboard for browsing your runs -generate-html-structure : create a top level html veiw to list targets/runs and a Run view within each run directory. -list-run-time : list time requered to complete runs. It supports following switches -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text> -list-test-time : list time requered to complete each test in a run. It following following arguments -runname <patt> -target <patt> -dumpmode <csv,json,plain-text> |
︙ | ︙ | |||
297 298 299 300 301 302 303 304 305 306 307 308 309 310 | "-logpro" "-m" "-rerun" "-days" "-rename-run" "-to" ;; values and messages ":category" ":variable" ":value" ":expected" ":tol" ":units" | > | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 | "-logpro" "-m" "-rerun" "-days" "-rename-run" "-to" "-dest" ;; values and messages ":category" ":variable" ":value" ":expected" ":tol" ":units" |
︙ | ︙ | |||
327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 | "-setvars" "-set-state-status" ;; move runs stuff here "-remove-keep" "-set-run-status" "-age" "-archive" "-actions" "-precmd" "-debug" ;; for *verbosity* > 2 "-create-test" "-override-timeout" "-test-files" ;; -test-paths is for listing all "-load" ;; load and exectute a scheme file "-section" | > > > > > | 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 | "-setvars" "-set-state-status" ;; move runs stuff here "-remove-keep" "-set-run-status" "-age" ;; archive "-archive" "-actions" "-precmd" "-include" "-exclude-rx" "-exclude-rx-from" "-debug" ;; for *verbosity* > 2 "-create-test" "-override-timeout" "-test-files" ;; -test-paths is for listing all "-load" ;; load and exectute a scheme file "-section" |
︙ | ︙ | |||
503 504 505 506 507 508 509 | (start-watchdog (null? no-watchdog-args-vals))) ;;(BB> "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals) (if start-watchdog (thread-start! *watchdog*))) ;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions | | | > > > > > > | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | (start-watchdog (null? no-watchdog-args-vals))) ;;(BB> "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals) (if start-watchdog (thread-start! *watchdog*))) ;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions (define (open-logfile logpath-in) (condition-case (let* ((log-dir (or (pathname-directory logpath-in) ".")) (fname (pathname-strip-directory logpath-in)) (logpath (if (> (string-length fname) 250) (let ((newlogf (conc log-dir "/" (common:get-signature fname) ".log"))) (debug:print 0 *default-log-port* "WARNING: log file " logpath-in " path too long, converted to " newlogf) newlogf) logpath-in))) (if (not (directory-exists? log-dir)) (system (conc "mkdir -p " log-dir))) (open-output-file logpath)) (exn () (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath) (define *didsomething* #t) (exit 1)))) |
︙ | ︙ | |||
1039 1040 1041 1042 1043 1044 1045 | ;;====================================================================== ;; Remove old run(s) ;;====================================================================== ;; since several actions can be specified on the command line the removal ;; is done first | | > > > > > > > > | > | > < | | > | | > | | | | 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 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 | ;;====================================================================== ;; 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)(target-in #f)(runname-in #f)(keys-in #f)(keyvals-in #f)) ;; #f is "use default" (let* ((runrec (runs:runrec-make-record)) (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-test-name)) (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") (exit 1)) ((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 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") (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 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))))) (if (args:get-arg "-kill-runs") (general-run-call |
︙ | ︙ | |||
1862 1863 1864 1865 1866 1867 1868 | ;;====================================================================== ;; Archive tests ;;====================================================================== ;; Archive tests matching target, runname, and testpatt (if (args:get-arg "-archive") ;; else do a general-run-call | > > > > > > > | | | | | | 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 | ;;====================================================================== ;; Archive tests ;;====================================================================== ;; Archive tests matching target, runname, and testpatt (if (args:get-arg "-archive") ;; else do a general-run-call (begin ;; for the archive get we need to preserve the starting dir as part of the target path (if (and (args:get-arg "-dest") (not (equal? (substring (args:get-arg "-dest") 0 1) "/"))) (let ((newpath (conc (current-directory) "/" (args:get-arg "-dest")))) (debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath) (hash-table-set! args:arg-hash "-dest" newpath))) (general-run-call "-archive" "Archive" (lambda (target runname keys keyvals) (operate-on 'archive target-in: target runname-in: runname ))))) ;;====================================================================== ;; Extract a spreadsheet from the runs database ;;====================================================================== (if (args:get-arg "-extract-ods") (general-run-call |
︙ | ︙ |
Modified runs.scm from [6cea658ad9] to [af2d0a75d8].
︙ | ︙ | |||
235 236 237 238 239 240 241 | (define (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs) ;; Take advantage of a good place to exit if running the one-pass methodology (if (and (> (runs:dat-can-run-more-tests-count runsdat) 20) (args:get-arg "-one-pass")) (exit 0)) | | > > > > | < | | > > | 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 | (define (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs) ;; Take advantage of a good place to exit if running the one-pass methodology (if (and (> (runs:dat-can-run-more-tests-count runsdat) 20) (args:get-arg "-one-pass")) (exit 0)) (thread-sleep! (cond ;; BB: check with Matt. Should this sleep move ;; to cond clauses below where we determine we ;; have too many jobs running rather than each ;; time the and condition above is true (which ;; seems like always)? ((> (runs:dat-can-run-more-tests-count runsdat) 20) ;; original intent was - save cycles, wait a long time (if (runs:lownoise "waiting on tasks" 60)(debug:print-info 2 *default-log-port* "waiting for tasks to complete, sleeping briefly ...")) 10) ;; obviously haven't had any work to do for a while (else ;; if have a number for inter-test-delay, use it, else don't delay much, maybe even zero? (configf:lookup-number *configdat* "setup" "inter-test-delay" default: 0.01)))) (let* ((num-running (rmt:get-count-tests-running run-id)) (num-running-in-jobgroup (rmt:get-count-tests-running-in-jobgroup run-id jobgroup)) (job-group-limit (let ((jobg-count (configf:lookup *configdat* "jobgroups" jobgroup))) (if (string? jobg-count) (string->number jobg-count) jobg-count)))) |
︙ | ︙ | |||
1279 1280 1281 1282 1283 1284 1285 | (let ((curr-sec (current-seconds))) (if (> (- curr-sec (runs:gendat-inc-results-last-update *runs:general-data*)) 5) ;; at least five seconds since last update (let* ((run-dat (or (runs:gendat-run-info *runs:general-data*)(rmt:get-run-info run-id))) (runname (or (runs:gendat-runname *runs:general-data*) (db:get-value-by-header (db:get-rows run-dat) (db:get-header run-dat) "runname"))) (target (or (runs:gendat-target *runs:general-data*)(rmt:get-target run-id))) | > | | | | | | | | > > > > > > > | 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 | (let ((curr-sec (current-seconds))) (if (> (- curr-sec (runs:gendat-inc-results-last-update *runs:general-data*)) 5) ;; at least five seconds since last update (let* ((run-dat (or (runs:gendat-run-info *runs:general-data*)(rmt:get-run-info run-id))) (runname (or (runs:gendat-runname *runs:general-data*) (db:get-value-by-header (db:get-rows run-dat) (db:get-header run-dat) "runname"))) (target (or (runs:gendat-target *runs:general-data*)(rmt:get-target run-id))) (testsdat (let ((res (rmt:get-tests-for-run run-id "%" '() '() ;; run-id testpatt states statuses #f #f ;; offset limit #f ;; not-in #f ;; sort-by #f ;; sort-order #f ;; get full data (not 'shortlist) (runs:gendat-inc-results-last-update *runs:general-data*) ;; last update time 'dashboard))) (if (list? res) res (begin (debug:print-error 0 *default-log-port* "FAILED TO GET DATA using rmt:get-tests-for-run. Notify developers if you see this. result: " res) '()))))) (if (not (runs:gendat-run-info *runs:general-data*)) (runs:gendat-run-info-set! *runs:general-data* run-dat)) (if (not (runs:gendat-runname *runs:general-data*)) (runs:gendat-runname-set! *runs:general-data* runname)) (if (not (runs:gendat-target *runs:general-data*)) (runs:gendat-target-set! *runs:general-data* target)) (for-each |
︙ | ︙ | |||
2103 2104 2105 2106 2107 2108 2109 | (header (vector-ref rundat 0)) (runs (vector-ref rundat 1)) (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)) | | > | 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 | (header (vector-ref rundat 0)) (runs (vector-ref rundat 1)) (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". (test-records '())) ;; for tasks that we wish to operate on all tests in one fell swoop (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 .") |
︙ | ︙ | |||
2137 2138 2139 2140 2141 2142 2143 | (let* ((run-id (db:get-value-by-header run header "id")) (run-state (db:get-value-by-header run header "state")) (run-name (db:get-value-by-header run header "runname")) (tests (if (not (equal? run-state "locked")) (proc-get-tests run-id) '())) (lasttpath "/does/not/exist/I/hope") | | | 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 | (let* ((run-id (db:get-value-by-header run header "id")) (run-state (db:get-value-by-header run header "state")) (run-name (db:get-value-by-header run header "runname")) (tests (if (not (equal? run-state "locked")) (proc-get-tests run-id) '())) (lasttpath "/does/not/exist/I/hope") (lastrealpath "/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 "%") |
︙ | ︙ | |||
2164 2165 2166 2167 2168 2169 2170 | ((print-run) (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) action) ((run-wait) (debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete")) ((archive) (debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname")) | > | | | | | | | | > > | | | | | > > > | 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 | ((print-run) (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) action) ((run-wait) (debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete")) ((archive) (debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname")) (let ((op (string->symbol (args:get-arg "-archive")))) (set! worker-thread (make-thread (lambda () (case op ((save save-remove keep-html) (archive:run-bup op run-id run-name tests rp-mutex bup-mutex)) ((restore) (archive:bup-restore op run-id run-name tests rp-mutex bup-mutex)) ((get) ;;; NOTE: This is a special case. We wish to operate on ALL tests in one go (set! test-records (append tests test-records))) (else (debug:print-error 0 *default-log-port* "unrecognised sub command " op " for -archive. Run \"megatest\" to see help") (exit)))) "archive-bup-thread")) (thread-start! worker-thread) (if (eq? op 'get) (thread-join! worker-thread)) ;; we need the test-records set to not overlap )) (else (debug:print-info 0 *default-log-port* "action not recognised " action))) ;; actions that operate on one test at a time can be handled below ;; (let ((sorted-tests (filter vector? |
︙ | ︙ | |||
2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 | (debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir))))))) (if (not (null? tal)) (loop (car tal)(cdr tal)))) ))) ) (if worker-thread (thread-join! worker-thread))) (common:join-backgrounded-threads)))) ;; remove the run if zero tests remain (if (eq? action 'remove-runs) (let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above? (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t))) (if (null? remtests) ;; no more tests remaining ;; Remove the last dir from the path. ;; And same for the link-resolved path | > | 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 | (debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir))))))) (if (not (null? tal)) (loop (car tal)(cdr tal)))) ))) ) (if worker-thread (thread-join! worker-thread))) (common:join-backgrounded-threads)))) ;; remove the run if zero tests remain (if (eq? action 'remove-runs) (let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above? (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t))) (if (null? remtests) ;; no more tests remaining ;; Remove the last dir from the path. ;; And same for the link-resolved path |
︙ | ︙ | |||
2421 2422 2423 2424 2425 2426 2427 | (debug:print 1 *default-log-port* "Recursively removing real dir " realpath) (runs:recursive-delete-with-error-msg realpath) ))))) )) runs) | | > > | | | | 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 | (debug:print 1 *default-log-port* "Recursively removing real dir " realpath) (runs:recursive-delete-with-error-msg realpath) ))))) )) runs) ;; special case - archive get (if (equal? (args:get-arg "-archive") "get") (archive:bup-get-data "get" #f #f test-records rp-mutex bup-mutex)) ) #t ) (define (runs:remove-test-directory test mode) ;; remove-data-only) (let* ((run-dir (db:test-get-rundir test)) ;; run dir is from the link tree (real-dir (if (common:file-exists? run-dir) ;; (resolve-pathname run-dir) (common:nice-path run-dir) #f)) |
︙ | ︙ | |||
2498 2499 2500 2501 2502 2503 2504 | ;;====================================================================== ;; Routines for manipulating runs ;;====================================================================== ;; Since many calls to a run require pretty much the same setup ;; this wrapper is used to reduce the replication of code (define (general-run-call switchname action-desc proc) | | | 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 | ;;====================================================================== ;; Routines for manipulating runs ;;====================================================================== ;; Since many calls to a run require pretty much the same setup ;; this wrapper is used to reduce the replication of code (define (general-run-call switchname action-desc proc) (let ((runname (common:args-get-runname)) (target (common:args-get-target))) (cond ((not target) (debug:print-error 0 *default-log-port* "Missing required parameter for " switchname ", you must specify the target with -target") (exit 3)) ((not runname) (debug:print-error 0 *default-log-port* "Missing required parameter for " switchname ", you must specify the run name with -runname runname") |
︙ | ︙ |