Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -612,46 +612,46 @@ (let ((cmd (iup:attribute command-text-box "VALUE"))) (system (conc cmd " &")))))) (kill-jobs (lambda (x) (iup:attribute-set! command-text-box "VALUE" - (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " :runname " runname + (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " -runname " runname " -set-state-status KILLREQ,n/a -testpatt %/% " ;; (conc testname "/" (if (equal? item-path "") "%" item-path)) - " :state RUNNING ;echo Press any key to continue;bash -c 'read -n 1 -s'\"")))) + " -state RUNNING ;echo Press any key to continue;bash -c 'read -n 1 -s'\"")))) (run-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" - (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " :runname " runname + (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " -runname " runname " -runtests " (conc testname "/" (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 -geometry 180x20 -e \"megatest -remove-runs -target " keystring " :runname " runname + (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " -runname " runname " -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) " -v ;echo Press any key to continue;bash -c 'read -n 1 -s'\"")))) (clean-run-execute (lambda (x) (let ((cmd (conc "xterm -geometry 180x20 -e \"" - "megatest -remove-runs -target " keystring " :runname " runname + "megatest -remove-runs -target " keystring " -runname " runname " -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) - ";megatest -target " keystring " :runname " runname + ";megatest -target " keystring " -runname " runname " -runtests " (conc testname "/" (if (equal? item-path "") "%" item-path)) " ;echo Press any key to continue;bash -c 'read -n 1 -s'\""))) (system (conc cmd " &"))))) (remove-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" - (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " :runname " runname + (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " -runname " runname " -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) " -v ;echo Press any key to continue;bash -c 'read -n 1 -s'\"")) ))) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -647,16 +647,16 @@ (set! full-cmd (conc full-cmd " -runtests " test-patt " -target " target - " :runname " + " -runname " run-name ))) ((remove-runs) (set! full-cmd (conc full-cmd - " -remove-runs :runname " + " -remove-runs -runname " run-name " -target " target " -testpatt " test-patt Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2065,10 +2065,24 @@ res)) ;;====================================================================== ;; M I S C M A N A G E M E N T I T E M S ;;====================================================================== + +;; A routine to map itempaths using a itemmap +(define (db:compare-itempaths patha pathb itemmap) + (debug:print-info 3 "ITEMMAP is " itemmap) + (if itemmap + (let* ((mapparts (string-split itemmap)) + (pattern (car mapparts)) + (replacement (if (> (length mapparts) 1) (cadr mapparts) ""))) + (if replacement + (equal? (string-substitute pattern replacement patha) + (string-substitute pattern replacement pathb)) + (equal? (string-substitute pattern "" patha) + (string-substitute pattern "" pathb)))) + (equal? patha pathb))) ;; the new prereqs calculation, looks also at itempath if specified ;; all prereqs must be met: ;; if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met ;; if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met @@ -2075,11 +2089,12 @@ ;; ;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED) ;; mode 'toplevel means that tests must be COMPLETED only ;; mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]] ;; -(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode) +;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode) +(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f)) (if (or (not waitons) (null? waitons)) '() (let* ((unmet-pre-reqs '()) (result '())) @@ -2100,17 +2115,17 @@ (item-path (db:test-get-item-path test)) (is-completed (equal? state "COMPLETED")) (is-running (equal? state "RUNNING")) (is-killed (equal? state "KILLED")) (is-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP"))) - (same-itempath (equal? ref-item-path item-path))) + (same-itempath (db:compare-itempaths ref-item-path item-path itemmap))) ;; (equal? ref-item-path item-path))) (set! ever-seen #t) (cond ;; case 1, non-item (parent test) is - ((and (equal? item-path "") ;; this is the parent test + ((and (equal? item-path "") ;; this is the parent test of the waiton being examined is-completed - (or is-ok (not (null? (lset-intersection eq? mode '(toplevel itemmatch itemwait)))))) + (or is-ok (not (null? (lset-intersection eq? mode '(toplevel)))))) ;; itemmatch itemwait)))))) (set! parent-waiton-met #t)) ;; Special case for toplevel and KILLED ((and (equal? item-path "") ;; this is the parent test is-killed (member 'toplevel mode)) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -61,27 +61,27 @@ Launching and managing runs -runall : run all tests that are not state COMPLETED and status PASS, CHECK or KILLED -runtests tst1,tst2 ... : run tests - -remove-runs : remove the data for a run, requires :runname and -testpatt + -remove-runs : remove the data for a run, requires -runname and -testpatt 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... : force re-run for tests with specificed status(s) -lock : lock run specified by target and runname -unlock : unlock run specified by target and runname - -set-run-status status : sets status for run to status, requires -target and :runname + -set-run-status status : sets status for run to status, requires -target and -runname -get-run-status : gets status for run specified by target and runname -run-wait : wait on run specified by target and runname Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.) -target key1/key2/... : run for key1, key2, etc. -reqtarg key1/key2/... : run for key1, key2, etc. but key1/key2 must be in runconfig -testpatt patt1/patt2,patt3/... : % is wildcard - :runname : required, name for this particular test run - :state : Applies to runs, tests or steps depending on context - :status : Applies to runs, tests or steps depending on context + -runname : required, name for this particular test run + -state : Applies to runs, tests or steps depending on context + -status : Applies to runs, tests or steps depending on context Test helpers (for use inside tests) -step stepname -test-status : set the state and status of a test (use :state and :status) -setlog logfname : set the path/filename to the final log relative to the test @@ -149,11 +149,11 @@ -gen-megatest-test tname : create a skeleton megatest test. You will be prompted for info Examples # Get test path, use '.' to get a single path or a specific path/file pattern -megatest -test-files 'logs/*.log' -target ubuntu/n%/no% :runname w49% -testpatt test_mt% +megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt% Called as " (string-intersperse (argv) " ") " Version " megatest-version ", built from " megatest-fossil-hash )) ;; -gui : start a gui interface @@ -164,11 +164,10 @@ (argv) (list "-runtests" ;; run a specific test "-config" ;; override the config file name "-execute" ;; run the command encoded in the base64 parameter "-step" - ":runname" "-target" "-reqtarg" ":runname" "-runname" ":state" @@ -214,11 +213,11 @@ "-var" "-dumpmode" "-run-id" "-ping" ) - (list "-h" + (list "-h" "-help" "--help" "-version" "-force" "-xterm" "-showkeys" "-show-keys" @@ -266,11 +265,13 @@ "-q" ;; quiet 0, errors/warnings only ) args:arg-hash 0)) -(if (args:get-arg "-h") +(if (or (args:get-arg "-h") + (args:get-arg "-help") + (args:get-arg "--help")) (begin (print help) (exit))) (if (args:get-arg "-start-dir") @@ -534,12 +535,13 @@ (target (common:args-get-target))) (cond ((not target) (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify -target or -reqtarg") (exit 1)) - ((not (args:get-arg ":runname")) - (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the run name pattern with :runname patt") + ((not (or (args:get-arg ":runname") + (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)) (else @@ -548,14 +550,14 @@ (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 action target - (args:get-arg ":runname") + (or (args:get-arg "-runname")(args:get-arg ":runname")) (args:get-arg "-testpatt") - state: (args:get-arg ":state") - status: (args:get-arg ":status") + state: (or (args:get-arg "-state")(args:get-arg ":state") ) + status: (or (args:get-arg "-status")(args:get-arg ":status")) new-state-status: (args:get-arg "-set-state-status"))) (set! *didsomething* #t))))) (if (args:get-arg "-remove-runs") (general-run-call @@ -753,11 +755,11 @@ "-rollup" "rollup tests" (lambda (target runname keys keyvals) (runs:rollup-run keys keyvals - (args:get-arg ":runname") + (or (args:get-arg "-runname")(args:get-arg ":runname") ) user)))) ;;====================================================================== ;; Lock or unlock a run ;;====================================================================== @@ -768,11 +770,11 @@ "lock/unlock tests" (lambda (target runname keys keyvals) (runs:handle-locking target keys - (args:get-arg ":runname") + (or (args:get-arg "-runname")(args:get-arg ":runname") ) (args:get-arg "-lock") (args:get-arg "-unlock") user)))) ;;====================================================================== @@ -876,11 +878,11 @@ "-extract-ods" "Make ods spreadsheet" (lambda (target runname keys keyvals) (let ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t)) (outputfile (args:get-arg "-extract-ods")) - (runspatt (args:get-arg ":runname")) + (runspatt (or (args:get-arg "-runname")(args:get-arg ":runname"))) (pathmod (args:get-arg "-pathmod"))) ;; (keyvalalist (keys->alist keys "%"))) (debug:print 2 "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvals: " keyvals) (db:extract-ods-file dbstruct outputfile keyvals (if runspatt runspatt "%") pathmod) (db:close-all dbstruct) Index: mt.scm ================================================================== --- mt.scm +++ mt.scm @@ -82,11 +82,11 @@ full-list new-offset limit)) full-list)))) -(define (mt:lazy-get-prereqs-not-met run-id waitons ref-item-path #!key (mode '(normal))) +(define (mt:lazy-get-prereqs-not-met run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f) ) (let* ((key (list run-id waitons ref-item-path mode)) (res (hash-table-ref/default *pre-reqs-met-cache* key #f)) (useres (let ((last-time (if (vector? res) (vector-ref res 0) #f))) (if last-time (< (current-seconds)(+ last-time 5)) @@ -93,11 +93,12 @@ #f)))) (if useres (let ((result (vector-ref res 1))) (debug:print 4 "Using lazy value res: " result) result) - (let ((newres (rmt:get-prereqs-not-met run-id waitons ref-item-path mode: mode))) + (let ((newres (rmt:get-prereqs-not-met run-id waitons ref-item-path mode: mode itemmap: itemmap))) +;; (let ((newres (db:get-prereqs-not-met run-id waitons ref-item-path mode: mode itemmap: itemmap))) (hash-table-set! *pre-reqs-met-cache* key (vector (current-seconds) newres)) newres)))) (define (mt:get-run-stats dbstruct run-id) ;; Get run stats from local access, move this ... but where? @@ -183,17 +184,24 @@ (if tconf tconf (let ((test-dirs (tests:get-tests-search-path *configdat*))) (let loop ((hed (car test-dirs)) (tal (cdr test-dirs))) + ;; Setting MT_LINKTREE here is almost certainly unnecessary. (let ((tconfig-file (conc hed "/" test-name "/testconfig"))) (if (and (file-exists? tconfig-file) (file-read-access? tconfig-file)) - (let ((newtcfg (read-config tconfig-file #f #f))) ;; NOTE: Does NOT run [system ...] - (hash-table-set! *testconfigs* test-name newtcfg) - newtcfg) + (let ((link-tree-path (configf:lookup *configdat* "setup" "linktree")) + (old-link-tree (get-environment-variable "MT_LINKTREE"))) + (if link-tree-path (setenv "MT_LINKTREE" link-tree-path)) + (let ((newtcfg (read-config tconfig-file #f #f))) ;; NOTE: Does NOT run [system ...] + (hash-table-set! *testconfigs* test-name newtcfg) + (if old-link-tree + (setenv "MT_LINKTREE" old-link-tree) + (unsetenv "MT_LINKTREE")) + newtcfg)) (if (null? tal) (begin (debug:print 0 "ERROR: No readable testconfig found for " test-name) #f) (loop (car tal)(cdr tal)))))))))) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -44,12 +44,12 @@ (begin (debug:print 0 "ERROR: Called setup in a non-megatest area, exiting") (exit 1))))) (runrec (runs:runrec-make-record)) (target (common:args-get-target)) - (runname (or (args:get-arg ":runname") - (args:get-arg "-runname"))) + (runname (or (args:get-arg "-runname") + (args:get-arg ":runname"))) (testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests"))) (keys (keys:config-get-fields mconfig)) (keyvals (keys:target->keyval keys target)) (toppath *toppath*) @@ -89,16 +89,20 @@ (configf:get-section runconfig section))) (list "default" target)) (vector target runname testpatt keys keyvals envdat mconfig runconfig serverdat transport db toppath run-id))) (define (set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)) - (let* ((target (or (common:args-get-target) - (get-environment-variable "MT_TARGET"))) + (let* ((target (or (common:args-get-target) + (get-environment-variable "MT_TARGET"))) (keys (if inkeys inkeys (rmt:get-keys))) - (keyvals (if inkeyvals inkeyvals (keys:target->keyval keys target))) - (vals (hash-table-ref/default *env-vars-by-run-id* run-id #f))) + (keyvals (if inkeyvals inkeyvals (keys:target->keyval keys target))) + (vals (hash-table-ref/default *env-vars-by-run-id* run-id #f)) + (link-tree (configf:lookup *configdat* "setup" "linktree"))) ;; get the info from the db and put it in the cache + (if link-tree + (setenv "MT_LINKTREE" link-tree) + (debug:print 0 "ERROR: linktree not set, should be set in megatest.config in [setup] section.")) (if (not vals) (let ((ht (make-hash-table))) (hash-table-set! *env-vars-by-run-id* run-id ht) (set! vals ht) (for-each @@ -373,13 +377,14 @@ '() reg))) (define runs:nothing-left-in-queue-count 0) -(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records) +(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmap) (let* ((loop-list (list hed tal reg reruns)) - (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path testmode)) + (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path testmode itemmap: itemmap)) + ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap)) (fails (runs:calc-fails prereqs-not-met)) (non-completed (runs:calc-not-completed prereqs-not-met))) (debug:print-info 4 "START OF INNER COND #2 " "\n can-run-more: " can-run-more "\n testname: " hed @@ -571,28 +576,31 @@ (runs:queue-next-tal tal reg reglen regfull) (runs:queue-next-reg tal reg reglen regfull) reruns))))) ;; (list (car newtal)(cdr newtal) reg reruns))))) (define (runs:mixed-list-testname-and-testrec->list-of-strings inlst) - (map (lambda (t) - (cond - ((vector? t) - (conc (db:test-get-state t) "/" (db:test-get-status t))) - ((string? t) - t) - (else - (conc t)))) - inlst)) - -(define (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry) + (if (null? inlst) + '() + (map (lambda (t) + (cond + ((vector? t) + (conc (db:test-get-state t) "/" (db:test-get-status t))) + ((string? t) + t) + (else + (conc t)))) + inlst))) + +(define (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry itemmap) (let* ((run-limits-info (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running (have-resources (car run-limits-info)) (num-running (list-ref run-limits-info 1)) (num-running-in-jobgroup (list-ref run-limits-info 2)) (max-concurrent-jobs (list-ref run-limits-info 3)) (job-group-limit (list-ref run-limits-info 4)) - (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path testmode)) + (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path testmode itemmap: itemmap)) + ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap)) (fails (runs:calc-fails prereqs-not-met)) (non-completed (runs:calc-not-completed prereqs-not-met)) (loop-list (list hed tal reg reruns))) (debug:print-info 4 "have-resources: " have-resources " prereqs-not-met: (" (string-intersperse @@ -601,11 +609,11 @@ (conc (db:test-get-state t) "/" (db:test-get-status t)) (conc " WARNING: t is not a vector=" t ))) prereqs-not-met) ", ") ") fails: " fails) (if (not (null? prereqs-not-met)) - (debug:print-info 1 "waiting on tests; " (string-intersperse (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) ", "))) + (debug:print-info 2 "waiting on tests; " (string-intersperse (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) ", "))) ;; 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? (debug:print-info 4 "run-limits-info = " run-limits-info) @@ -711,11 +719,10 @@ ;; (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) (if (not (null? prereqs-not-met)) (debug:print-info 1 "waiting on tests; " (string-intersperse (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) ", "))) - (if (null? fails) (begin ;; couldn't run, take a breather (debug:print-info 0 "Waiting for more work to do...") (thread-sleep! 1) @@ -730,17 +737,31 @@ ;; (thread-sleep! *global-delta*) (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'removed) (list (runs:queue-next-hed tal reg reglen regfull) (runs:queue-next-tal tal reg reglen regfull) (runs:queue-next-reg tal reg reglen regfull) - (cons hed reruns))) + reruns ;; WAS: (cons hed reruns) ;; but that makes no sense? + )) (begin - (debug:print 0 "WARNING: Test not processed correctly. Could be a race condition in your test implementation? Dropping test " hed) ;; " as it has prerequistes that are FAIL. (NOTE: hed is not a vector)") + (debug:print 0 "WARNING: Test may not have processed correctly. Could be a race condition in your test implementation? Dropping test " hed) ;; " as it has prerequistes that are FAIL. (NOTE: hed is not a vector)") (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (list hed tal reg reruns) - (list (car newtal)(cdr newtal) reg reruns) - )))))))) + ;; (list (car newtal)(cdr newtal) reg reruns) + (list (runs:queue-next-hed tal reg reglen regfull) + (runs:queue-next-tal tal reg reglen regfull) + (runs:queue-next-reg tal reg reglen regfull) + reruns) ;; (cons hed reruns)) + ;;(list (if (null? tal)(car newtal)(car tal)) + ;; tal + ;; reg + ;; reruns) + )) + ;; can't drop this - maybe running? Just keep trying + (list hed + tal + reg + reruns))))))) ;; every time though the loop increment the test/itempatt val. ;; when the min is > max-allowed and none running then force exit ;; (define *max-tries-hash* (make-hash-table)) @@ -799,10 +820,11 @@ (test-name (tests:testqueue-get-testname test-record)) (tconfig (tests:testqueue-get-testconfig test-record)) (jobgroup (config-lookup tconfig "test_meta" "jobgroup")) (testmode (let ((m (config-lookup tconfig "requirements" "mode"))) (if m (map string->symbol (string-split m)) '(normal)))) + (itemmap (configf:lookup tconfig "requirements" "itemmap")) (waitons (tests:testqueue-get-waitons test-record)) (priority (tests:testqueue-get-priority test-record)) (itemdat (tests:testqueue-get-itemdat test-record)) ;; itemdat can be a string, list or #f (items (tests:testqueue-get-items test-record)) (item-path (item-list->path itemdat)) @@ -884,11 +906,11 @@ ((not items) (debug:print-info 4 "OUTER COND: (not items)") (if (and (not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path required: required-tests)) (not (null? tal))) (loop (car tal)(cdr tal) reg reruns)) - (let ((loop-list (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry))) + (let ((loop-list (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry itemmap))) (if loop-list (apply loop loop-list)))) ;; items processed into a list but not came in as a list been processed ;; ((and (list? items) ;; thus we know our items are already calculated @@ -939,11 +961,11 @@ ;; EXPAND ITEMS ((or (procedure? items)(eq? items 'have-procedure)) (let ((can-run-more (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs))) (if (and (list? can-run-more) (car can-run-more)) - (let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records))) + (let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmap))) (if loop-list (apply loop loop-list))) ;; if can't run more just loop with next possible test (loop (car newtal)(cdr newtal) reg reruns)))) @@ -1387,18 +1409,18 @@ ;;====================================================================== ;; 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) - (let ((runname (args:get-arg ":runname")) + (let ((runname (or (args:get-arg "-runname")(args:get-arg ":runname"))) (target (common:args-get-target))) (cond ((not target) (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the target with -target") (exit 3)) ((not runname) - (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with :runname runname") + (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with -runname runname") (exit 3)) (else (let ((db #f) (keys #f)) (if (not (setup-for-run)) @@ -1485,11 +1507,11 @@ ;; This could probably be refactored into one complex query ... ;; NOT PORTED - DO NOT USE YET ;; (define (runs:rollup-run keys runname user keyvals) - (debug:print 4 "runs:rollup-run, keys: " keys " :runname " runname " user: " user) + (debug:print 4 "runs:rollup-run, keys: " keys " -runname " runname " user: " user) (let* ((db #f) ;; register run operates on the main db (new-run-id (rmt:register-run keyvals runname "new" "n/a" user)) (prev-tests (rmt:get-matching-previous-test-run-records new-run-id "%" "%")) (curr-tests (mt:get-tests-for-run new-run-id "%/%" '() '())) Index: tests/fdktestqa/testqa/Makefile ================================================================== --- tests/fdktestqa/testqa/Makefile +++ tests/fdktestqa/testqa/Makefile @@ -1,9 +1,12 @@ BINDIR = $(PWD)/../../../bin PATH := $(BINDIR):$(PATH) MEGATEST = $(BINDIR)/megatest DASHBOARD = $(BINDIR)/dashboard +RUNNAME = a + + all : $(MEGATEST) -remove-runs -target a/b :runname c -testpatt %/% $(MEGATEST) -runtests % -target a/b :runname c bigbig : @@ -15,13 +18,17 @@ $(MEGATEST) -runtests bigrun -target a/bigrun :runname a$(shell date +%V) bigrun2 : $(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a$(shell date +%V) +bigrun3 : + $(MEGATEST) -runtests bigrun3 -target a/bigrun3 :runname $(RUNNAME) + dashboard : $(DASHBOARD) -rows 20 & compile : (cd ../../..;make && make install) clean : rm -rf ../simple*/*/* megatest.db db/* + Index: tests/fdktestqa/testqa/megatest.config ================================================================== --- tests/fdktestqa/testqa/megatest.config +++ tests/fdktestqa/testqa/megatest.config @@ -1,8 +1,8 @@ [setup] testcopycmd cp --remove-destination -rlv TEST_SRC_PATH/. TEST_TARG_PATH/. >> TEST_TARG_PATH/mt_launch.log 2>> TEST_TARG_PATH/mt_launch.log -launchwait no +# launchwait no [jobtools] launcher loadrunner [include ../fdk.config] Index: tests/fdktestqa/testqa/tests/bigrun/step1.sh ================================================================== --- tests/fdktestqa/testqa/tests/bigrun/step1.sh +++ tests/fdktestqa/testqa/tests/bigrun/step1.sh @@ -1,9 +1,13 @@ -#!/bin/sh -if [ $NUMBER -lt 15 ];then +#!/bin/bash +if [ $NUMBER -lt 10 ];then sleep 2 - sleep `echo 2 * $NUMBER | bc` + sleep `echo 4 * $NUMBER | bc` else - sleep 100 + sleep 130 fi -exit 0 +if [[ $RANDOM -lt 10000 ]];then + exit 1 +else + exit 0 +fi Index: tests/fdktestqa/testqa/tests/bigrun2/testconfig ================================================================== --- tests/fdktestqa/testqa/tests/bigrun2/testconfig +++ tests/fdktestqa/testqa/tests/bigrun2/testconfig @@ -5,15 +5,19 @@ # Test requirements are specified here [requirements] waiton bigrun priority 0 mode itemwait - +itemmap .*/ # Iteration for your tests are controlled by the items section [items] -NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (<= a (or (any->number (get-environment-variable "NUMTESTS")) 2500))(loop (+ a 1)(cons a res)) res)) <)) " ")} +NUMBER #{scheme (string-intersperse (map (lambda (x)(conc "blah/" x)) \ + (map number->string (sort (let loop ((a 0)(res '())) \ + (if (<= a (or (any->number (get-environment-variable "NUMTESTS")) 2500)) \ + (loop (+ a 1)(cons a res)) res)) <))) " ")} + # test_meta is a section for storing additional data on your test [test_meta] author matt owner matt Index: tests/fdktestqa/testqa/tests/bigrun3/testconfig ================================================================== --- tests/fdktestqa/testqa/tests/bigrun3/testconfig +++ tests/fdktestqa/testqa/tests/bigrun3/testconfig @@ -5,15 +5,18 @@ # Test requirements are specified here [requirements] waiton bigrun2 priority 0 mode itemwait - +itemmap .*/ # Iteration for your tests are controlled by the items section [items] -NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (<= a (or (any->number (get-environment-variable "NUMTESTS")) 2500))(loop (+ a 1)(cons a res)) res)) <)) " ")} +NUMBER #{scheme (string-intersperse (map (lambda (x)(conc "blah/" x)) \ + (map number->string (sort (let loop ((a 0)(res '())) \ + (if (<= a (or (any->number (get-environment-variable "NUMTESTS")) 2500)) \ + (loop (+ a 1)(cons a res)) res)) <))) " ")} # test_meta is a section for storing additional data on your test [test_meta] author matt owner matt