Check-in [f8f7968767]
Not logged in
Overview
SHA1 Hash:f8f7968767e4adce6d4f5006d5b60cb93358e254
Date: 2011-08-08 23:24:05
User: mrwellan
Comment:Minor refactoring of run code.
Timelines: family | ancestors | descendants | both | rollup-runs
Diffs: root of this branch
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified megatest.scm from [1da1e82fdcb4133e] to [8ae7c5dabf1cb010].

263 ;; else 263 ;; else 264 ;; put task in deferred queue 264 ;; put task in deferred queue 265 ;; if still ok to run tasks 265 ;; if still ok to run tasks 266 ;; process deferred tasks per above steps 266 ;; process deferred tasks per above steps 267 267 268 ;; run all tests are are Not COMPLETED and PASS or CHECK 268 ;; run all tests are are Not COMPLETED and PASS or CHECK 269 (if (args:get-arg "-runall") 269 (if (args:get-arg "-runall") 270 (if (not (args:get-arg ":runname")) | 270 (general-run-call 271 (begin | 271 "-runall" 272 (debug:print 0 "ERROR: Missing required parameter for -runtests, you m | 272 "run all tests" 273 (exit 2)) | 273 (lambda (db keys keynames keyvallst) 274 (let* ((db (if (setup-for-run) < 275 (open-db) < 276 (begin < 277 (debug:print 0 "Failed to setup, exiting") < 278 (exit 1))))) < 279 (if (not (car *configinfo*)) < 280 (begin < 281 (debug:print 0 "ERROR: Attempted to run a test but run area conf < 282 (exit 1)) < 283 ;; put test parameters into convenient variables < 284 (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored fo | 274 (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now 285 (debug:print 1 "INFO: Attempting to start the following tests... | 275 (debug:print 1 "INFO: Attempting to start the following tests...") 286 (debug:print 1 " " (string-intersperse test-names ",")) | 276 (debug:print 1 " " (string-intersperse test-names ",")) 287 (run-tests db test-names))) | 277 (run-tests db test-names))))) 288 ;; (run-waiting-tests db) < 289 (sqlite3:finalize! db) < 290 (set! *didsomething* #t)))) < 291 278 292 ;;====================================================================== 279 ;;====================================================================== 293 ;; Rollup into a run 280 ;; Rollup into a run 294 ;;====================================================================== 281 ;;====================================================================== 295 (if (args:get-arg "-rollup") 282 (if (args:get-arg "-rollup") > 283 (general-run-call > 284 "-rollup" > 285 "rollup tests" > 286 (lambda (db keys keynames keyvallst) > 287 (let ((n (args:get-arg "-rollup"))) > 288 (runs:rollup db keys keynames keyvallst n))))) 296 289 297 ;;====================================================================== 290 ;;====================================================================== 298 ;; run one test 291 ;; run one test 299 ;;====================================================================== 292 ;;====================================================================== 300 293 301 ;; 1. find the config file 294 ;; 1. find the config file 302 ;; 2. change to the test directory 295 ;; 2. change to the test directory ................................................................................................................................................................................ 306 ;; 5. as the test proceeds internally it calls megatest as each step is 299 ;; 5. as the test proceeds internally it calls megatest as each step is 307 ;; started and completed 300 ;; started and completed 308 ;; - step started, timestamp 301 ;; - step started, timestamp 309 ;; - step completed, exit status, timestamp 302 ;; - step completed, exit status, timestamp 310 ;; 6. test phone home 303 ;; 6. test phone home 311 ;; - if test run time > allowed run time then kill job 304 ;; - if test run time > allowed run time then kill job 312 ;; - if cannot access db > allowed disconnect time then kill job 305 ;; - if cannot access db > allowed disconnect time then kill job > 306 313 307 314 (define (runtests) 308 (define (runtests) 315 (if (not (args:get-arg ":runname")) | 309 (general-run-call 316 (begin | 310 "-runtests" 317 (debug:print 0 "ERROR: Missing required parameter for -runtests, you mus | 311 "run a test" 318 (exit 2)) | 312 (lambda (db keys keynames keyvallst) 319 (let ((db #f)) < 320 (if (not (setup-for-run)) < 321 (begin < 322 (debug:print 0 "Failed to setup, exiting") < 323 (exit 1))) < 324 (set! db (open-db)) < 325 (if (not (car *configinfo*)) < 326 (begin < 327 (debug:print 0 "ERROR: Attempted to run a test but run area config < 328 (exit 1)) < 329 ;; put test parameters into convenient variables < 330 (let* ((test-names (string-split (args:get-arg "-runtests") ","))) | 313 (let ((test-names (string-split (args:get-arg "-runtests") ","))) 331 (run-tests db test-names))) | 314 (run-tests db test-names))))) 332 ;; run-waiting-tests db) < 333 (sqlite3:finalize! db) < 334 ;; (run-waiting-tests #f) < 335 (set! *didsomething* #t)))) < 336 315 337 (if (args:get-arg "-runtests") 316 (if (args:get-arg "-runtests") 338 (runtests)) 317 (runtests)) 339 318 340 ;;====================================================================== 319 ;;====================================================================== 341 ;; execute the test 320 ;; execute the test 342 ;; - gets called on remote host 321 ;; - gets called on remote host ................................................................................................................................................................................ 515 (if (vector-ref exit-info 1) ;; look at 494 (if (vector-ref exit-info 1) ;; look at 516 (if (and (not kill-job?) 495 (if (and (not kill-job?) 517 (eq? (vector-ref exit-info 496 (eq? (vector-ref exit-info 518 "PASS" 497 "PASS" 519 "FAIL") 498 "FAIL") 520 "FAIL") itemdat (args:get-arg "-m")) 499 "FAIL") itemdat (args:get-arg "-m")) 521 ;; for automated creation of the rollup html file this is a good 500 ;; for automated creation of the rollup html file this is a good > 501 (if (not (equal? item-path "")) 522 (tests:summarize-items db run-id test-name #f) ;; don't force - | 502 (tests:summarize-items db run-id test-name #f)) ;; don't forc 523 ) 503 ) 524 (mutex-unlock! m) 504 (mutex-unlock! m) 525 ;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (con 505 ;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (con 526 ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) 506 ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) 527 (debug:print 2 "Output from running " fullrunscript ", pid " (vect 507 (debug:print 2 "Output from running " fullrunscript ", pid " (vect 528 work-area ":\n====\n exit code " (vector-ref exit-info 2) " 508 work-area ":\n====\n exit code " (vector-ref exit-info 2) " 529 (sqlite3:finalize! db) 509 (sqlite3:finalize! db)

Modified runs.scm from [5279d57c0ec2406b] to [b9d0916f140660e6].

636 )) 636 )) 637 runs))) 637 runs))) 638 638 639 ;;====================================================================== 639 ;;====================================================================== 640 ;; Routines for manipulating runs 640 ;; Routines for manipulating runs 641 ;;====================================================================== 641 ;;====================================================================== 642 642 > 643 ;; Since many calls to a run require pretty much the same setup > 644 ;; this wrapper is used to reduce the replication of code > 645 (define (general-run-call switchname action-desc proc) > 646 (if (not (args:get-arg ":runname")) > 647 (begin > 648 (debug:print 0 "ERROR: Missing required parameter for " switchname ", yo > 649 (exit 2)) > 650 (let ((db #f)) > 651 (if (not (setup-for-run)) > 652 (begin > 653 (debug:print 0 "Failed to setup, exiting") > 654 (exit 1))) > 655 (set! db (open-db)) > 656 (if (not (car *configinfo*)) > 657 (begin > 658 (debug:print 0 "ERROR: Attempted to " action-desc " but run area c > 659 (exit 1)) > 660 ;; Extract out stuff needed in most or many calls > 661 ;; here then call proc > 662 (let* ((keys (db-get-keys db)) > 663 (keynames (map key:get-fieldname keys)) > 664 (keyvallst (keys->vallist keys #t))) > 665 (proc db keys keynames keyvallst))) > 666 (sqlite3:finalize! db) > 667 (set! *didsomething* #t)))) > 668 643 (define (runs:rollup-run db keys n) | 669 (define (runs:rollup-run db keys keynames keyvallst n) 644 (let* ((new-run-id (register-run db keys)) 670 (let* ((new-run-id (register-run db keys)) 645 (similar-runs (db:get-similar-runs db keys)) 671 (similar-runs (db:get-similar-runs db keys)) 646 (tests-n-days (db:get-tests-n-days db similar-runs))) 672 (tests-n-days (db:get-tests-n-days db similar-runs))) 647 (for-each 673 (for-each 648 (lambda (test-id) 674 (lambda (test-id) 649 (db:rollup-test db run-id test-id)) 675 (db:rollup-test db run-id test-id)) 650 tests-n-days))) 676 tests-n-days)))