Overview
Comment: | Adding locking of runs. -remove-runs skips runs with state of locked |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors |
Files: | files | file ages | folders |
SHA1: |
f07eeb7fa58cddf3f63f5a4d62785ae4 |
User & Date: | matt on 2012-04-03 00:46:44 |
Other Links: | branch diff | manifest | tags |
Context
2012-04-03
| ||
00:46 | Adding locking of runs. -remove-runs skips runs with state of locked Closed-Leaf check-in: f07eeb7fa5 user: matt | |
00:05 | Fixed storage of path to be link dir, not run dir check-in: c4dc36c8ef user: matt tags: trunk, v1.41 | |
Changes
Modified megatest.scm from [02de8ae88c] to [ff47085649].
︙ | ︙ | |||
87 88 89 90 91 92 93 94 95 96 97 98 99 100 | and :runname ,-testpatt and -itempatt and -testpatt -rerun FAIL,WARN... : re-run if called on a test that previously ran (nullified if -keepgoing is also specified) -rebuild-db : bring the database schema up to date -rollup : fill run (set by :runname) with latest test(s) from prior runs with same keys -update-meta : update the tests metadata for all tests -env2file fname : write the environment to fname.csh and fname.sh -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are overwritten by values set in config files. -archive : archive tests, use -target, :runname, -itempatt and -testpatt -server -|hostname : start the server (reduces contention on megatest.db), use - to automatically figure out hostname | > > | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | and :runname ,-testpatt and -itempatt and -testpatt -rerun FAIL,WARN... : re-run if called on a test that previously ran (nullified if -keepgoing is also specified) -rebuild-db : bring the database schema up to date -rollup : fill run (set by :runname) with latest test(s) from prior runs with same keys -lock : lock the run specified by target and runname as locked which prevents -remove-runs from removing the run -update-meta : update the tests metadata for all tests -env2file fname : write the environment to fname.csh and fname.sh -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are overwritten by values set in config files. -archive : archive tests, use -target, :runname, -itempatt and -testpatt -server -|hostname : start the server (reduces contention on megatest.db), use - to automatically figure out hostname |
︙ | ︙ | |||
174 175 176 177 178 179 180 181 182 183 184 185 186 187 | "-set-values" "-load-test-data" "-summarize-items" "-gui" ;; misc "-archive" "-repl" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first "-runall" ;; run all tests "-remove-runs" "-keepgoing" "-usequeue" | > | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | "-set-values" "-load-test-data" "-summarize-items" "-gui" ;; misc "-archive" "-repl" "-lock" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first "-runall" ;; run all tests "-remove-runs" "-keepgoing" "-usequeue" |
︙ | ︙ |
Modified runs.scm from [dcd447f66f] to [f5e1ed9051].
︙ | ︙ | |||
502 503 504 505 506 507 508 | (runs (vector-ref rundat 1))) (debug:print 1 "Header: " header) (for-each (lambda (run) (let ((runkey (string-intersperse (map (lambda (k) (db:get-value-by-header run header (vector-ref k 0))) keys) "/")) (dirs-to-remove (make-hash-table))) | | > > | > | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 | (runs (vector-ref rundat 1))) (debug:print 1 "Header: " header) (for-each (lambda (run) (let ((runkey (string-intersperse (map (lambda (k) (db:get-value-by-header run header (vector-ref k 0))) keys) "/")) (dirs-to-remove (make-hash-table))) (let* ((run-id (db:get-value-by-header run header "id")) (run-state (db:get-value-by-header run header "state")) (tests (if (not (equal? run-state "locked")) (rdb:get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt '() '()) '())) (lasttpath "/does/not/exist/I/hope")) (if (not (equal? run-state "locked")) (begin (if (not (null? tests)) (begin (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")) (for-each (lambda (test) (let* ((item-path (db:test-get-item-path test)) (test-name (db:test-get-testname test)) (run-dir (db:test-get-rundir test))) (debug:print 1 " " (db:test-get-testname test) " id: " (db:test-get-id test) " " item-path) (rdb:delete-test-records db (db:test-get-id test)) (if (> (string-length run-dir) 5) ;; bad heuristic but should prevent /tmp /home etc. (let ((fullpath run-dir)) ;; "/" (db:test-get-item-path test)))) (set! lasttpath fullpath) (hash-table-set! dirs-to-remove fullpath #t) ;; The following was the safe delete code but it was not being exectuted. ;; (let* ((dirs-count (+ 1 (length keys)(length (string-split item-path "/")))) ;; (dir-to-rem (get-dir-up-n fullpath dirs-count)) ;; (remainingd (string-substitute (regexp (conc "^" dir-to-rem "/")) "" fullpath)) ;; (cmd (conc "cd " dir-to-rem "; rmdir -p " remainingd ))) ;; (if (file-exists? fullpath) ;; (begin ;; (debug:print 1 cmd) ;; (system cmd))) ;; )) )))) tests))) ;; look though the dirs-to-remove for candidates for removal. Do this after deleting the records ;; for each test in case we get killed. That should minimize the detritus left on disk ;; process the dirs from longest string length to shortest (for-each (lambda (dir-to-remove) (if (file-exists? dir-to-remove) (let ((dir-in-db '())) (sqlite3:for-each-row (lambda (dir) (set! dir-in-db (cons dir dir-in-db))) db "SELECT rundir FROM tests WHERE rundir LIKE ?;" (conc "%" dir-to-remove "%")) ;; yes, I'm going to bail if there is anything like this dir in the db (if (null? dir-in-db) (begin (debug:print 2 "Removing directory with zero db references: " dir-to-remove) (system (conc "rm -rf " dir-to-remove)) (hash-table-delete! dirs-to-remove dir-to-remove)) (debug:print 2 "Skipping removal of " dir-to-remove " for now as it still has references in the database"))))) (sort (hash-table-keys dirs-to-remove) (lambda (a b)(> (string-length a)(string-length b))))) ;; remove the run if zero tests remain (let ((remtests (rdb:get-tests-for-run db (db:get-value-by-header run header "id") #f #f '() '()))) (if (null? remtests) ;; no more tests remaining (let* ((dparts (string-split lasttpath "/")) (runpath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))) (debug:print 1 "Removing run: " runkey " " (db:get-value-by-header run header "runname")) (db:delete-run db run-id) ;; need to figure out the path to the run dir and remove it if empty ;; (if (null? (glob (conc runpath "/*"))) ;; (begin ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) )))) )))) runs))) ;;====================================================================== ;; Routines for manipulating runs ;;====================================================================== ;; Since many calls to a run require pretty much the same setup |
︙ | ︙ |