Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -249,24 +249,23 @@ ((red) "223 33 49") ((grey) "192 192 192") ((orange) "255 172 13") ((purple) "This is unfinished ..."))) -(define (common:get-color-for-state-status state status type) +(define (common:get-color-for-state-status state status) (case (string->symbol state) ((COMPLETED) - (if (equal? status "PASS") - "70 249 73" - (if (or (equal? status "WARN") - (equal? status "WAIVED")) - "255 172 13" - "223 33 49"))) ;; greenish orangeish redish + (case (string->symbol status) + ((PASS) "70 249 73") + ((WARN WAIVED) "255 172 13") + ((SKIP) "230 230 0") + (else "223 33 49"))) ((LAUNCHED) "101 123 142") ((CHECK) "255 100 50") - ((REMOTEHOSTSTART) "50 130 195") - ((RUNNING) "9 131 232") - ((KILLREQ) "39 82 206") + ((REMOTEHOSTSTART) "50 130 195") + ((RUNNING) "9 131 232") + ((KILLREQ) "39 82 206") ((KILLED) "234 101 17") ((NOT_STARTED) "240 240 240") (else "192 192 192"))) (define (common:get-color-from-status status) Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -62,11 +62,11 @@ (lambda (testdat) (let ((newstatus (db:test-get-status testdat)) (oldstatus (iup:attribute lbl "TITLE"))) (if (not (equal? oldstatus newstatus)) (begin - (iup:attribute-set! lbl "FGCOLOR" (get-color-for-state-status (db:test-get-state testdat) + (iup:attribute-set! lbl "FGCOLOR" (common:get-color-for-state-status (db:test-get-state testdat) (db:test-get-status testdat))) (iup:attribute-set! lbl "TITLE" (db:test-get-status testdat))))))) lbl) (store-label "testcomment" (iup:label "TestComment " @@ -188,11 +188,11 @@ ;; state status teststeps (define *state-status* (vector #f #f #f)) (define (update-state-status-buttons testdat) (let* ((state (db:test-get-state testdat)) (status (db:test-get-status testdat)) - (color (get-color-for-state-status state status))) + (color (common:get-color-for-state-status state status))) ((vector-ref *state-status* 0) state color) ((vector-ref *state-status* 1) status color))) ;;====================================================================== ;; Set fields @@ -237,11 +237,11 @@ #:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10" #:action (lambda (x) (open-run-close db:test-set-state-status-by-id #f test-id #f status #f) (db:test-set-status! testdat status))))) btn)) - (list "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED")))) + (list "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP")))) (vector-set! *state-status* 1 (lambda (status color) (for-each (lambda (btn) (let* ((name (iup:attribute btn "TITLE")) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -318,28 +318,10 @@ (iup:attribute-set! lbl "TITLE" munged-val))) (iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0")) (if (< i maxn) (loop (+ i 1))))))) -(define (get-color-for-state-status state status) - (case (string->symbol state) - ((COMPLETED) - (if (equal? status "PASS") - "70 249 73" - (if (or (equal? status "WARN") - (equal? status "WAIVED")) - "255 172 13" - "223 33 49"))) ;; greenish orangeish redish - ((LAUNCHED) "101 123 142") - ((CHECK) "255 100 50") - ((REMOTEHOSTSTART) "50 130 195") - ((RUNNING) "9 131 232") - ((KILLREQ) "39 82 206") - ((KILLED) "234 101 17") - ((NOT_STARTED) "240 240 240") - (else "192 192 192"))) - (define (update-buttons uidat numruns numtests) (if *please-update-buttons* (let* ((runs (if (> (length *allruns*) numruns) (take-right *allruns* numruns) (pad-list *allruns* numruns))) @@ -414,11 +396,11 @@ (teststate (db:test-get-state test)) (teststart (db:test-get-event_time test)) (runtime (db:test-get-run_duration test)) (buttontxt (if (equal? teststate "COMPLETED") teststatus teststate)) (button (vector-ref columndat rown)) - (color (get-color-for-state-status teststate teststatus)) + (color (common:get-color-for-state-status teststate teststatus)) (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR")) (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE"))) (if (not (equal? curr-color color)) (iup:attribute-set! button "BGCOLOR" color)) (if (not (equal? curr-title buttontxt)) @@ -502,11 +484,11 @@ (iup:toggle status #:action (lambda (obj val) (mark-for-update) (if (eq? val 1) (hash-table-set! *status-ignore-hash* status #t) (hash-table-delete! *status-ignore-hash* status))))) - '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a"))) + '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP"))) (apply iup:hbox (map (lambda (state) (iup:toggle state #:action (lambda (obj val) (mark-for-update) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -337,11 +337,11 @@ (define (runs:calc-fails prereqs-not-met) (filter (lambda (test) (and (vector? test) ;; not (string? test)) (equal? (db:test-get-state test) "COMPLETED") (not (member (db:test-get-status test) - '("PASS" "WARN" "CHECK" "WAIVED"))))) + '("PASS" "WARN" "CHECK" "WAIVED" "SKIP"))))) prereqs-not-met)) (define (runs:calc-not-completed prereqs-not-met) (filter (lambda (t) @@ -691,11 +691,11 @@ ((member (test:get-state testdat) '("DELETED" "NOT_STARTED"))(set! runflag #t)) ;; not -rerun and PASS, WARN or CHECK, do no run ((and (or (not rerun) keepgoing) ;; Require to force re-run for COMPLETED or *anything* + PASS,WARN or CHECK - (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK")) + (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK" "SKIP")) (member (test:get-state testdat) '("COMPLETED")))) (debug:print-info 2 "running test " test-name "/" item-path " suppressed as it is " (test:get-state testdat) " and " (test:get-status testdat)) (set! runflag #f)) ;; -rerun and status is one of the specifed, run it ((and rerun Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -509,11 +509,11 @@ (tdat (cdb:get-test-info-by-id *runremote* test-id))) (if tdat (begin ;; Look at the test state and status (if (or (member (db:test-get-status tdat) - '("PASS" "WARN" "WAIVED" "CHECK")) + '("PASS" "WARN" "WAIVED" "CHECK" "SKIP")) (member (db:test-get-state tdat) '("INCOMPLETE" "KILLED"))) (set! keep-test #f)) ;; examine waitons for any fails. If it is FAIL or INCOMPLETE then eliminate this test