Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -429,6 +429,5 @@ ;; (not (hash-table-ref/default non-completed (db:test-get-testname x) #f))) ;; tests))) ;; (pre-dep-names (map db:test-get-testname completed-tests)) ;; (result (lset-difference string=? waiton pre-dep-names))) ;; (print "pre-dep-names: " pre-dep-names " waiton: " waiton " result: " result) - Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -54,13 +54,10 @@ -keepgoing : continue running until no jobs are \"LAUNCHED\" or \"NOT_STARTED\" -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 N : fill run (set by :runname) with latest test(s) from - past N days, requires keys - -rename-run : rename run (set by :runname) to , requires keys Helpers -runstep stepname ... : take remaining params as comand and execute as stepname log will be in stepname.log. Best to put command in quotes -logpro file : with -exec apply logpro file to stepname.log, creates @@ -91,13 +88,10 @@ "-set-toplog" "-runstep" "-logpro" "-m" "-rerun" - "-days" - "-rename-run" - "-to" "-debug" ;; for *verbosity* > 2 ) (list "-h" "-force" "-xterm" @@ -108,11 +102,10 @@ "-runall" ;; run all tests "-remove-runs" "-keepgoing" "-usequeue" "-rebuild-db" - "-rollup" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only ) args:arg-hash 0)) @@ -265,29 +258,31 @@ ;; if still ok to run tasks ;; process deferred tasks per above steps ;; run all tests are are Not COMPLETED and PASS or CHECK (if (args:get-arg "-runall") - (general-run-call - "-runall" - "run all tests" - (lambda (db keys keynames keyvallst) - (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now - (debug:print 1 "INFO: Attempting to start the following tests...") - (debug:print 1 " " (string-intersperse test-names ",")) - (run-tests db test-names))))) - -;;====================================================================== -;; Rollup into a run -;;====================================================================== -(if (args:get-arg "-rollup") - (general-run-call - "-rollup" - "rollup tests" - (lambda (db keys keynames keyvallst) - (let ((n (args:get-arg "-rollup"))) - (runs:rollup db keys keynames keyvallst n))))) + (if (not (args:get-arg ":runname")) + (begin + (debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname") + (exit 2)) + (let* ((db (if (setup-for-run) + (open-db) + (begin + (debug:print 0 "Failed to setup, exiting") + (exit 1))))) + (if (not (car *configinfo*)) + (begin + (debug:print 0 "ERROR: Attempted to run a test but run area config file not found") + (exit 1)) + ;; put test parameters into convenient variables + (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now + (debug:print 1 "INFO: Attempting to start the following tests...") + (debug:print 1 " " (string-intersperse test-names ",")) + (run-tests db test-names))) + ;; (run-waiting-tests db) + (sqlite3:finalize! db) + (set! *didsomething* #t)))) ;;====================================================================== ;; run one test ;;====================================================================== @@ -302,19 +297,33 @@ ;; - step completed, exit status, timestamp ;; 6. test phone home ;; - if test run time > allowed run time then kill job ;; - if cannot access db > allowed disconnect time then kill job - (define (runtests) - (general-run-call - "-runtests" - "run a test" - (lambda (db keys keynames keyvallst) - (let ((test-names (string-split (args:get-arg "-runtests") ","))) - (run-tests db test-names))))) - + (if (not (args:get-arg ":runname")) + (begin + (debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname") + (exit 2)) + (let ((db #f)) + (if (not (setup-for-run)) + (begin + (debug:print 0 "Failed to setup, exiting") + (exit 1))) + (set! db (open-db)) + (if (not (car *configinfo*)) + (begin + (debug:print 0 "ERROR: Attempted to run a test but run area config file not found") + (exit 1)) + ;; put test parameters into convenient variables + (let* ((test-names (string-split (args:get-arg "-runtests") ","))) + (run-tests db test-names))) + ;; run-waiting-tests db) + (sqlite3:finalize! db) + ;; (run-waiting-tests #f) + (set! *didsomething* #t)))) + (if (args:get-arg "-runtests") (runtests)) ;;====================================================================== ;; execute the test @@ -496,12 +505,11 @@ (eq? (vector-ref exit-info 2) 0)) "PASS" "FAIL") "FAIL") itemdat (args:get-arg "-m")))) ;; for automated creation of the rollup html file this is a good place... - (if (not (equal? item-path "")) - (tests:summarize-items db run-id test-name #f)) ;; don't force - just update if no + (tests:summarize-items db run-id test-name #f) ;; don't force - just update if no ) (mutex-unlock! m) ;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (conc test-name "-run.log")))) ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -633,44 +633,5 @@ ;; (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 -;; this wrapper is used to reduce the replication of code -(define (general-run-call switchname action-desc proc) - (if (not (args:get-arg ":runname")) - (begin - (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with :runname runname") - (exit 2)) - (let ((db #f)) - (if (not (setup-for-run)) - (begin - (debug:print 0 "Failed to setup, exiting") - (exit 1))) - (set! db (open-db)) - (if (not (car *configinfo*)) - (begin - (debug:print 0 "ERROR: Attempted to " action-desc " but run area config file not found") - (exit 1)) - ;; Extract out stuff needed in most or many calls - ;; here then call proc - (let* ((keys (db-get-keys db)) - (keynames (map key:get-fieldname keys)) - (keyvallst (keys->vallist keys #t))) - (proc db keys keynames keyvallst))) - (sqlite3:finalize! db) - (set! *didsomething* #t)))) - -(define (runs:rollup-run db keys keynames keyvallst n) - (let* ((new-run-id (register-run db keys)) - (similar-runs (db:get-similar-runs db keys)) - (tests-n-days (db:get-tests-n-days db similar-runs))) - (for-each - (lambda (test-id) - (db:rollup-test db run-id test-id)) - tests-n-days)))