Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -519,10 +519,17 @@ (5 "COMPLETED") (6 "LAUNCHED") (7 "REMOTEHOSTSTART") (8 "RUNNING") )) + +(define *common:dont-roll-up-states* + '("DELETED" + "REMOVING" + "CLEANING" + "ARCHIVE_REMOVING" + )) ;; BBnote: *common:std-statuses* dashboard filter control and test control status buttons defined here; used in set-fields-panel and dboard:make-controls ;; note these statuses are sorted from better to worse. ;; This sort order is important to dcommon:status-compare3 and db:set-state-status-and-roll-up-items (define *common:std-statuses* @@ -556,10 +563,16 @@ (define *common:cant-run-states* ;; These are stopping conditions that prevent a test from being run '("COMPLETED" "KILLED" "UNKNOWN" "INCOMPLETE" "ARCHIVED")) (define *common:not-started-ok-statuses* ;; if not one of these statuses when in not_started state treat as dead '("n/a" "na" "PASS" "FAIL" "WARN" "CHECK" "WAIVED" "DEAD" "SKIP")) + +;; group tests into buckets corresponding to rollup +;;; Running, completed-pass, completed-non-pass + worst status, not started. +;; filter out +;(define (common:categorize-items-for-rollup in-tests) +; ( (define (common:special-sort items order comp) (let ((items-order (map reverse order)) (acomp (or comp >))) (sort items Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3521,22 +3521,22 @@ ;; (non-completes (filter (lambda (x) ;; (not (equal? (dbr:counts-state x) "COMPLETED"))) ;; state-status-counts)) (all-curr-states (common:special-sort ;; worst -> best (sort of) (delete-duplicates - (if (not (equal? state "DELETED")) + (if (not (member state *common:dont-roll-up-states*)) (cons state (map dbr:counts-state state-status-counts)) (map dbr:counts-state state-status-counts))) *common:std-states* >)) (all-curr-statuses (common:special-sort ;; worst -> best (delete-duplicates - (if (not (equal? state "DELETED")) + (if (not (member state *common:dont-roll-up-states*)) (cons status (map dbr:counts-status state-status-counts)) (map dbr:counts-status state-status-counts))) *common:std-statuses* >)) (non-completes (filter (lambda (x) - (not (member x '("DELETED" "COMPLETED")))) + (not (member x (cons "COMPLETED" *common:dont-roll-up-states*)))) all-curr-states)) (num-non-completes (length non-completes)) (newstate (cond ((> running 0) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -1433,11 +1433,11 @@ itemdat))) (testprevvals (alist->env-vars (hash-table-ref/default tconfig "pre-launch-env-overrides" '()))) ;; Launchwait defaults to true, must override it to turn off wait (launchwait (if (equal? (configf:lookup *configdat* "setup" "launchwait") "no") #f #t)) - (launch-results (apply (if launchwait + (launch-results (apply (if launchwait ;; BB: TODO: refactor this to examine return code of launcher, if nonzero, set state to launch failed. process:cmd-run-with-stderr->list process-run) (if useshell (let ((cmdstr (string-intersperse fullcmd " "))) (if launchwait Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -308,17 +308,11 @@ (system (conc run-post-hook " >> " actual-logf " 2>&1")) (debug:print-info 0 *default-log-port* "post-hook \"" run-post-hook "\" took " (- (current-seconds) start-time) " seconds to run.")))))) ;; return #t when all items in waitors-upon list are represented in test-patt, #f otherwise. (define (runs:testpatts-mention-waitors-upon? test-patt waitors-upon) - (let* ((tests-in-testpatt - (map - (lambda (test-patt-item) - (car (string-split test-patt-item "/"))) - (string-split test-patt ","))) - (waitors-upon-not-mentioned (lset-difference equal? waitors-upon tests-in-testpatt))) - (null? waitors-upon-not-mentioned))) + (null? (tests:filter-test-names-not-matched waitors-upon test-patt))) ;; test-names: Comma separated patterns same as test-patts but used in selection ;; of tests to run. The item portions are not respected. ;; FIXME: error out if /patt specified ;; @@ -424,12 +418,13 @@ ;; 1. fill required tests with test-patts ;; 2. scan testconfigs and if waitons, itemwait, itempatt calc prior test test-patt ;; 3. repeat until all deps propagated ;; any tests with direct mention in test-patts can be added to required + ;;(set! required-tests (lset-intersection equal? (string-split test-patts ",") all-test-names)) + (set! required-tests (tests:filter-test-names all-test-names test-patts)) ;; - (set! required-tests (lset-intersection equal? (string-split test-patts ",") all-test-names)) ;; (set! required-tests (lset-intersection equal? test-names all-test-names)) ;; look up all tests matching the comma separated list of globs in ;; test-patts (using % as wildcard) @@ -1460,11 +1455,12 @@ items))) (let* ((items-in-testpatt (filter (lambda (my-itemdat) - (tests:match test-patts hed (item-list->path my-itemdat) required: required-tests)) + (tests:match test-patts hed (item-list->path my-itemdat) )) + ;; was: (tests:match test-patts hed (item-list->path my-itemdat) required: required-tests)) items) )) (if (null? items-in-testpatt) (let ((test-id (rmt:get-test-id run-id test-name ""))) (debug:print-info 0 *default-log-port* "Test " (tests:testqueue-get-testname test-record) " is itemized but has no items matching test pattern -- marking status ZERO_ITEMS") (if test-id Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -72,10 +72,17 @@ (hash-table-set! test-registry tname test-path)))) (glob (conc hed "/*")))) (if (null? tal) test-registry (loop (car tal)(cdr tal)))))) + +(define (tests:filter-test-names-not-matched test-names test-patts) + (delete-duplicates + (filter (lambda (testname) + (not (tests:match test-patts testname #f))) + test-names))) + (define (tests:filter-test-names test-names test-patts) (delete-duplicates (filter (lambda (testname) (tests:match test-patts testname #f))