Overview
Comment: | Added -set-state-status to enable setting state and status |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
29cc9e826eea5fbe6df76a2eddc14701 |
User & Date: | matt on 2012-04-12 00:55:32 |
Other Links: | manifest | tags |
Context
2012-04-12
| ||
16:14 | Added helpful (hopefully) output on system and shell from config processing and launch processes check-in: b077e2bbcd user: mrwellan tags: trunk | |
00:55 | Added -set-state-status to enable setting state and status check-in: 29cc9e826e user: matt tags: trunk | |
2012-04-11
| ||
17:38 | Fixed patt-list-match failing on multi wild cards check-in: 205ca47739 user: mrwellan tags: trunk | |
Changes
Modified megatest.scm from [8aad599e04] to [c096f14df6].
︙ | ︙ | |||
79 80 81 82 83 84 85 | -itempatt patt : in list-runs show only tests with items that match patt -showkeys : show the keys used in this megatest setup -test-paths targpatt : get the most recent test path(s) matching targpatt e.g. %/%... returns list sorted by age ascending, see examples below Misc -force : override some checks | | | | | < | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | -itempatt patt : in list-runs show only tests with items that match patt -showkeys : show the keys used in this megatest setup -test-paths targpatt : get the most recent test path(s) matching targpatt e.g. %/%... returns list sorted by age ascending, see examples below Misc -force : override some checks -remove-runs : remove the data for a run, requires :runname, -testpatt and -itempatt be set. Optionally use :state and :status -set-state-status X,Y : set state to X and status to Y, requires controls per -remove-runs -rerun FAIL,WARN... : re-run if called on a test that previously ran -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 |
︙ | ︙ | |||
161 162 163 164 165 166 167 168 169 170 171 172 173 174 | ":units" ;; misc "-server" "-extract-ods" "-pathmod" "-env2file" "-setvars" "-debug" ;; for *verbosity* > 2 "-override-timeout" ) (list "-h" "-force" "-xterm" "-showkeys" | > | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | ":units" ;; misc "-server" "-extract-ods" "-pathmod" "-env2file" "-setvars" "-set-state-status" "-debug" ;; for *verbosity* > 2 "-override-timeout" ) (list "-h" "-force" "-xterm" "-showkeys" |
︙ | ︙ | |||
182 183 184 185 186 187 188 | "-repl" "-lock" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first "-runall" ;; run all tests "-remove-runs" | < | 182 183 184 185 186 187 188 189 190 191 192 193 194 195 | "-repl" "-lock" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first "-runall" ;; run all tests "-remove-runs" "-usequeue" "-rebuild-db" "-rollup" "-update-meta" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only |
︙ | ︙ | |||
226 227 228 229 230 231 232 | ;;====================================================================== ;; Remove old run(s) ;;====================================================================== ;; since several actions can be specified on the command line the removal ;; is done first | | | | | < < < < | < < < | | | | | | > | | | | | > | | | > > > > > > > | 225 226 227 228 229 230 231 232 233 234 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 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 | ;;====================================================================== ;; Remove old run(s) ;;====================================================================== ;; since several actions can be specified on the command line the removal ;; is done first (define (operate-on db action) (cond ((not (args:get-arg ":runname")) (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the run name pattern with :runname patt") (exit 2)) ((not (args:get-arg "-testpatt")) (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the test pattern with -testpatt") (exit 3)) ((not (args:get-arg "-itempatt")) (print "ERROR: Missing required parameter for " action ", you must specify the items with -itempatt") (exit 4)) (else (if (not (car *configinfo*)) (begin (debug:print 0 "ERROR: Attempted " action "on test(s) but run area config file not found") (exit 1)) ;; put test parameters into convenient variables (runs:operate-on db action (args:get-arg ":runname") (args:get-arg "-testpatt") (args:get-arg "-itempatt") state: (args:get-arg ":state") status: (args:get-arg ":status") new-state-status: (args:get-arg "-set-state-status"))) (sqlite3:finalize! db) (set! *didsomething* #t)))) (if (args:get-arg "-remove-runs") (general-run-call "-remove-runs" "remove runs" (lambda (db target runname keys keynames keyvallst) (operate-on db 'remove-runs)))) (if (args:get-arg "-set-state-status") (general-run-call "-set-state-status" "set state and status" (lambda (db target runname keys keynames keyvallst) (operate-on db 'set-state-status)))) ;;====================================================================== ;; Query runs ;;====================================================================== (if (args:get-arg "-list-runs") (let* ((db (begin |
︙ | ︙ |
Modified runs.scm from [26fc9a5dca] to [757a50bdeb].
︙ | ︙ | |||
494 495 496 497 498 499 500 | (let ((dparts (string-split dir "/")) (count (if (null? params) 1 (car params)))) (conc "/" (string-intersperse (take dparts (- (length dparts) count)) "/")))) ;; Remove runs ;; fields are passing in through | > > > | | | | | | | > | > > | > > > > > > | | | | | | | | | | | | | | | | > > > | > | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | 494 495 496 497 498 499 500 501 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 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 | (let ((dparts (string-split dir "/")) (count (if (null? params) 1 (car params)))) (conc "/" (string-intersperse (take dparts (- (length dparts) count)) "/")))) ;; Remove runs ;; fields are passing in through ;; action: ;; 'remove-runs ;; 'set-state-status (define (runs:operate-on db action runnamepatt testpatt itempatt #!key (state #f)(status #f)(new-state-status #f)) (let* ((keys (rdb:get-keys db)) (rundat (runs:get-runs-by-patt db keys runnamepatt)) (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)))) (debug:print 2 "Header: " header " action: " action " new-state-status: " new-state-status) (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 states statuses not-in: #f) '())) (lasttpath "/does/not/exist/I/hope")) (if (not (null? tests)) (begin (case action ((remove-runs) (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))) ((set-state-status) (debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname"))) (else (print "INFO: action not recognised " action))) (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) (case action ((remove-runs) (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))) ;; )) ))) ((set-state-status) (debug:print 4 "INFO: new state " (car state-status) ", new status " (cadr state-status)) (db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f))))) 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 (if (eq? action 'remove-runs) (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 (if (eq? action 'remove-runs) (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 ;;====================================================================== |
︙ | ︙ |
Modified tests/Makefile from [8a368d0627] to [13b200064d].
︙ | ︙ | |||
16 17 18 19 20 21 22 | test2 : cleanprep $(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10 test3 : cleanprep $(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER) test4 : cleanprep | | | | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | test2 : cleanprep $(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10 test3 : cleanprep $(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER) test4 : cleanprep $(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_aa -v $(SERVER) 2&>1 aa.log & $(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ab -v $(SERVER) 2&>1 ab.log & $(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ac -v $(SERVER) 2&>1 ac.log & $(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ad -v $(SERVER) 2&>1 ad.log & $(MEGATEST) -runtests runfirst -itempatt %/1 -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -v $(MEGATEST) -runtests runfirst -itempatt %blahha% -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -debug 10 cleanprep : ../*.scm Makefile *.config sqlite3 megatest.db "delete from metadat where var='SERVER';" mkdir -p /tmp/mt_runs /tmp/mt_links cd ..;make install |
︙ | ︙ |