Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1041,13 +1041,14 @@ is-completed is-ok) (set! item-waiton-met #t))))) tests) (if (not (or parent-waiton-met item-waiton-met)) - (set! result (cons waitontest-name result))) + (set! result (append tests result))) ;; if the test is not found then clearly the waiton is not met... - (if (not ever-seen)(set! result (cons waitontest-name result))))) + ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) + (if (not ever-seen)(set! result (append tests result))))) waitons) (delete-duplicates result)))) (define (db:teststep-set-status! db test-id teststep-name state-in status-in item-path comment logfile) (debug:print 4 "test-id: " test-id " teststep-name: " teststep-name) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -298,14 +298,25 @@ ;; no loop - drop though and use the loop at the bottom (if (patt-list-match item-path item-patts) (run:test db run-id runname keyvallst test-record flags #f) (debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts)) ;; else the run is stuck, temporarily or permanently - (let ((newtal (append tal (list hed)))) - ;; couldn't run, take a breather - (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient - (loop (car newtal)(cdr newtal)))))) + (let ((newtal (append tal (list hed))) + (fails (filter (lambda (test)(not (member (db:test-get-status test) + '("PASS" "WARN" "CHECK" "WAIVED")))) + prereqs-not-met))) + (debug:print 4 "FAILS: " fails) + ;; If one or more of the prereqs-not-met are FAIL then we can issue + ;; a message and drop hed from the items to be processed. + (if (null? fails) + (begin + ;; couldn't run, take a breather + (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient + (loop (car newtal)(cdr newtal))) + ;; the waiton is FAIL so no point in trying to run hed + (if (not (null? tal)) + (loop (car tal)(cdr tal)))))))) ;; case where an items came in as a list been processed ((and (list? items) ;; thus we know our items are already calculated (not itemdat)) ;; and not yet expanded into the list of things to be done (if (and (>= *verbosity* 1) @@ -334,28 +345,42 @@ (loop (car tal)(cdr tal)))) ;; if items is a proc then need to run items:get-items-from-config, get the list and loop ;; - but only do that if resources exist to kick off the job ((or (procedure? items)(eq? items 'have-procedure)) - (if (and (runs:can-run-more-tests db test-record) - (null? (db:get-prereqs-not-met db run-id waitons item-path))) - (let ((test-name (tests:testqueue-get-testname test-record))) - (setenv "MT_TEST_NAME" test-name) ;; - (setenv "MT_RUNNAME" runname) - (set-megatest-env-vars db run-id) ;; these may be needed by the launching process - (let ((items-list (items:get-items-from-config tconfig))) - (if (list? items-list) - (begin - (tests:testqueue-set-items! test-record items-list) - (loop hed tal)) - (begin - (debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this") - (exit 1))))) - (let ((newtal (append tal (list hed)))) - ;; if can't run more tests, lets take a breather - (thread-sleep! 0.1) ;; may as well wait a while for resources to free up - (loop (car newtal)(cdr newtal))))) + (let ((can-run-more (runs:can-run-more-tests db test-record)) + (prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path))) + (if (and can-run-more (null? prereqs-not-met)) + (let ((test-name (tests:testqueue-get-testname test-record))) + (setenv "MT_TEST_NAME" test-name) ;; + (setenv "MT_RUNNAME" runname) + (set-megatest-env-vars db run-id) ;; these may be needed by the launching process + (let ((items-list (items:get-items-from-config tconfig))) + (if (list? items-list) + (begin + (tests:testqueue-set-items! test-record items-list) + (loop hed tal)) + (begin + (debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this") + (exit 1))))) + (let ((newtal (append tal (list hed))) + (fails (filter (lambda (test) + (not (member (db:test-get-status test) + '("PASS" "WARN" "CHECK" "WAIVED")))) + prereqs-not-met))) + ;; if can't run more tests, lets take a breather + (debug:print 4 "FAILS: " fails) + ;; If one or more of the prereqs-not-met are FAIL then we can issue + ;; a message and drop hed from the items to be processed. + (if (null? fails) + (begin + ;; couldn't run, take a breather + (thread-sleep! 0.1) ;; long sleep here - no resources, may as well be patient + (loop (car newtal)(cdr newtal))) + ;; the waiton is FAIL so no point in trying to run hed + (if (not (null? tal)) + (loop (car tal)(cdr tal)))))))) ;; this case should not happen, added to help catch any bugs ((and (list? items) itemdat) (debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this") (exit 1)))) Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -5,49 +5,50 @@ PATH := $(BINPATH):$(PATH) RUNNAME := $(shell date +w%V.%u.%H.%M) IPADDR := "-" # Set SERVER to "-server -" SERVER := +DEBUG := 1 -runall : test1 test2 +all : test1 test 2 test3 test1 : cleanprep + mkdir -p simplelinks simpleruns + cd simplerun;echo '(load "../tests.scm")' | $(MEGATEST) -repl -debug $(DEBUG) + +test2 : fullprep cd fullrun;$(MEGATEST) -runtests ez_pass -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_a $(SERVER) -test2 : cleanprep +test3 : fullprep cd fullrun;$(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10 -test3 : cleanprep +test4 : fullprep cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER) -test4 : cleanprep +test5 : fullprep cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_aa -v $(SERVER) 2&>1 aa.log & cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ab -v $(SERVER) 2&>1 ab.log & cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ac -v $(SERVER) 2&>1 ac.log & cd fullrun;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ad -v $(SERVER) 2&>1 ad.log & cd fullrun;$(MEGATEST) -runtests runfirst -itempatt %/1 -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -v cd fullrun;$(MEGATEST) -runtests runfirst -itempatt %blahha% -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -debug 10 -cleanprep : ../*.scm Makefile *.config +cleanprep : ../*.scm Makefile */*.config sqlite3 megatest.db "delete from metadat where var='SERVER';" mkdir -p /tmp/mt_runs /tmp/mt_links cd ..;make install - cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt % -itempatt % - cd fullrun;$(BINPATH)/dboard -rows 15 & touch cleanprep -test : - csi -b -I .. ../megatest.scm -- -runall -target ubuntu/afs/tmp :runname blah - cd ../;make test - make runall - -dashboard : - cd ../;make install - cd fullrun;$(BINPATH)/dboard & +fullprep : cleanprep + cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt % -itempatt % + cd fullrun;$(BINPATH)/dboard -rows 15 & + +dashboard : cleanprep + cd fullrun && $(BINPATH)/dboard & remove : - (cd ../;make);cd fullrun;$(MEGATEST) -remove-runs :runname $(RUN) -testpatt % -itempatt % :sysname % :fsname % :datapath % + cd fullrun;$(MEGATEST) -remove-runs :runname $(RUN) -testpatt % -itempatt % :sysname % :fsname % :datapath % clean : rm cleanprep runforever : Index: tests/simplerun/megatest.config ================================================================== --- tests/simplerun/megatest.config +++ tests/simplerun/megatest.config @@ -6,10 +6,14 @@ # Adjust max_concurrent_jobs to limit how much you load your machines max_concurrent_jobs 50 # This is your link path, you can move it but it is generally better to keep it stable linktree ../simplelinks + +# Valid values for state and status for steps, NB// It is not recommended you use this +[validvalues] +state start end completed # Job tools are more advanced ways to control how your jobs are launched [jobtools] useshell yes launcher nbfind ADDED tests/simplerun/test.config Index: tests/simplerun/test.config ================================================================== --- /dev/null +++ tests/simplerun/test.config @@ -0,0 +1,31 @@ +[section1] +1 ./blah + +[section2] + +# A comment + +[disks] +1 ./ + +[validvalues] +state start end aborted +status pass fail n/a + +[include a file that doesn't exist] + + +blah nada + +# now inlcude a file tha tdoes exist +[include megatest.config] + +[metadata] +description This is a multiline + description. The leading whitespace is discarded + irrespective of amount of indenting. + This line is indented more. + + +author matt +lastreview never DELETED tests/test.config Index: tests/test.config ================================================================== --- tests/test.config +++ /dev/null @@ -1,31 +0,0 @@ -[section1] -1 ./blah - -[section2] - -# A comment - -[disks] -1 ./ - -[validvalues] -state start end aborted -status pass fail n/a - -[include a file that doesn't exist] - - -blah nada - -# now inlcude a file tha tdoes exist -[include megatest.config] - -[metadata] -description This is a multiline - description. The leading whitespace is discarded - irrespective of amount of indenting. - This line is indented more. - - -author matt -lastreview never Index: tests/tests.scm ================================================================== --- tests/tests.scm +++ tests/tests.scm @@ -1,19 +1,6 @@ -(use test) -;; (require-library args) - -(include "../megatest.scm") -(include "../common.scm") -(include "../keys.scm") -(include "../db.scm") -(include "../configf.scm") -(include "../process.scm") -(include "../launch.scm") -(include "../items.scm") -(include "../runs.scm") -(include "../runconfig.scm") -(include "../megatest-version.scm") +(require-extension test) (define test-work-dir (current-directory)) (define conffile #f) (test "Read a config" #t (hash-table? (read-config "test.config" #f #f))) @@ -61,28 +48,34 @@ (test "write env files" "nada.csh" (begin (save-environment-as-files "nada") (and (file-exists? "nada.sh") (file-exists? "nada.csh")))) -(test "get all legal tests" (list "runfirst" "runwithfirst" "singletest" "singletest2" "sqlitespeed") (sort (get-all-legal-tests) string<=?)) +(test "get all legal tests" (list "test1" "test2") (sort (get-all-legal-tests) string<=?)) (test "register-test, test info" "NOT_STARTED" (begin - (register-test *db* 1 "nada" "" '("tag1" "tag2" "tag3")) - (test:get-state (db:get-test-info *db* 1 "nada" "")))) + (tests:register-test *db* 1 "nada" "") + (vector-ref (db:get-test-info *db* 1 "nada" "") 3))) -(test "get-keys" "sysname" (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0))))))) +(test "get-keys" "SYSTEM" (vector-ref (car (db:get-keys *db*)) 0));; (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0))))))) (define remargs (args:get-args '("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada") (list ":runname" ":state" ":status") (list "-h") args:arg-hash 0)) -(test "register-run" #t (number? (register-run *db* (db-get-keys *db*)))) -(define keys (db-get-keys *db*)) +(test "register-run" #t (number? (runs:register-run *db* + (db:get-keys *db*) + '(("SYSTEM" "key1")("OS" "key2")) + "myrun" + "new" + "n/a" + "bob"))) +(define keys (db:get-keys *db*)) ;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada" (setenv "BLAHFOO" "1234") (unsetenv "NADAFOO") (test "env temp overrides" "xyz" (let ((prevvals (alist->env-vars '(("BLAHFOO" 4321)("NADAFOO" xyz)))) @@ -110,11 +103,14 @@ ;; force keepgoing ; (hash-table-set! args:arg-hash "-keepgoing" #t) (hash-table-set! args:arg-hash "-itempatt" "%") (hash-table-set! args:arg-hash "-testpatt" "%") (test "Setup for a run" #t (begin (setup-for-run) #t)) -(test "Remove the rollup run" #t (begin (remove-runs) #t)) + + +;; (test "Remove the rollup run" #t (begin (remove-runs) #t)) + (test "Run a test" #t (general-run-call "-runtests" "run a test" (lambda (db keys keynames keyvallst) (let ((test-names '("runfirst")))