Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -64,10 +64,23 @@ (else #f))) (define (any->number-if-possible val) (let ((num (any->number val))) (if num num val))) + +(define (patt-list-match item patts) + (if (and item patts) ;; here we are filtering for matches with -itempatt + (let ((res #f)) ;; look through all the item-patts if defined, format is patt1,patt2,patt3 ... wildcard is % + (for-each + (lambda (patt) + (if (string-match (glob->regexp + (string-translate patt "%" "*")) + item) + (set! res #t))) + (string-split patts ",")) + res) + #t)) ;;====================================================================== ;; System stuff ;;====================================================================== Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -346,19 +346,19 @@ command-text-box "VALUE" (conc "xterm -e \"megatest -runtests " testname " -target " keystring " :runname " runname " -itempatt " (if (equal? item-path "") "%" item-path) - "\"")))) + ";echo Press any key to continue;bash -c 'read -n 1 -s'\"")))) (remove-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "xterm -e \"megatest -remove-runs -target " keystring " :runname " runname " -testpatt " testname " -itempatt " (if (equal? item-path "") "%" item-path) - " -v\""))))) + " -v;echo Press any key to continue;bash -c 'read -n 1 -s'\""))))) (cond ((not testdat)(begin (print "ERROR: bad test info for " test-id)(exit 1))) ((not rundat)(begin (print "ERROR: found test info but there is a problem with the run info for " run-id)(exit 1))) (else ;; (test-set-status! db run-id test-name state status itemdat) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -292,11 +292,13 @@ ;; Don't know at this time if the test have been launched at some time in the past ;; i.e. is this a re-launch? (if (and have-resources (null? prereqs-not-met)) ;; no loop - drop though and use the loop at the bottom - (run:test db run-id runname keyvallst test-record flags #f) + (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.5) (loop (car newtal)(cdr newtal)))))) @@ -315,26 +317,12 @@ (for-each (lambda (my-itemdat) (let* ((new-test-record (let ((newrec (make-tests:testqueue))) (vector-copy! test-record newrec) newrec)) - (my-item-path (item-list->path my-itemdat)) - - ;; 3/25/2012 - this match is *always* returning true I believe. Or is it the tests that are not being handled? - ;; - (item-matches (if item-patts ;; here we are filtering for matches with -itempatt - (let ((res #f)) ;; look through all the item-patts if defined, format is patt1,patt2,patt3 ... wildcard is % - (for-each - (lambda (patt) - (if (string-search (glob->regexp - (string-translate patt "%" "*")) - item-path) - (set! res #t))) - (string-split item-patts ",")) - res) - #t))) - (if item-matches ;; yes, we want to process this item + (my-item-path (item-list->path my-itemdat))) + (if (patt-list-match my-item-path item-patts) ;; yes, we want to process this item (let ((newtestname (conc hed "/" my-item-path))) ;; test names are unique on testname/item-path (tests:testqueue-set-items! new-test-record #f) (tests:testqueue-set-itemdat! new-test-record my-itemdat) (tests:testqueue-set-item_path! new-test-record my-item-path) (hash-table-set! test-records newtestname new-test-record) Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -9,17 +9,17 @@ SERVER := "" runall : test1 test2 test1 : cleanprep - $(MEGATEST) -runtests ez_pass -target ubuntu/nfs/none :runname $(RUNNAME)_a $(SERVER) + $(MEGATEST) -runtests ez_pass -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_a $(SERVER) test2 : cleanprep - $(MEGATEST) -runtests runfirst -target ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10 + $(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10 test3 : cleanprep - $(MEGATEST) -runall -target ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER) + $(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER) cleanprep : ../*.scm sqlite3 megatest.db "delete from metadat where var='SERVER';" mkdir -p /tmp/mt_runs /tmp/mt_links cd ..;make ADDED tests/common_runconfigs.config Index: tests/common_runconfigs.config ================================================================== --- /dev/null +++ tests/common_runconfigs.config @@ -0,0 +1,15 @@ +[default] +FOOBARBAZZZZ not a useful value +BIGBOB $FOOBARBAZZZZ/bobby +FREDDY $sysname/$fsname +TOMMY [system pwd] + +[/tmp/mrwellan/env/ubuntu/afs] +BOGOUS Bob + +[default/ubuntu/nfs] +CURRENT /blah + +[ubuntu/nfs/none] +CURRENT /tmp/nada + Index: tests/runconfigs.config ================================================================== --- tests/runconfigs.config +++ tests/runconfigs.config @@ -1,15 +1,1 @@ -[/tmp/mrwellan/env/ubuntu/afs] -BOGOUS Bob - -[default/ubuntu/nfs] -CURRENT /blah - -[ubuntu/nfs/none] -CURRENT /tmp/nada - - -[default] -FOOBARBAZZZZ not a useful value -BIGBOB $FOOBARBAZZZZ/bobby -FREDDY $sysname/$fsname -TOMMY [system pwd] +[include common_runconfigs.config]