Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -1501,11 +1501,10 @@ (define (dashboard:xor-two-runs-updater commondat tabdat tb cell-lookup run-matrix ) - (print "BB> HeLLooo from xor-two-runs-updater") (let* ((runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (prev-run-id (dboard:tabdat-prev-run-id tabdat)) (curr-run-id (dboard:tabdat-curr-run-id tabdat)) (last-update 0) ;; fix me - have to create and store a rundat record for this Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -275,11 +275,11 @@ (tal (cdr tests-dat)) (res '())) (let* ((test-id (db:test-get-id hed)) ;; look at the tests-dat spec for locations (test-name (db:test-get-testname hed)) (item-path (db:test-get-item-path hed)) - (state (db:test-get-status hed)) + (state (db:test-get-state hed)) (status (db:test-get-status hed)) (newitem (list test-name item-path (list test-id state status)))) (if (null? tal) (reverse (cons newitem res)) (loop (car tal)(cdr tal)(cons newitem res))))))) @@ -314,20 +314,22 @@ (define (dcommon:xor-tests-mindat src-tests-mindat dest-tests-mindat) (let* ((src-hash (dcommon:tests-mindat->hash src-tests-mindat)) (dest-hash (dcommon:tests-mindat->hash dest-tests-mindat)) (all-keys - (sort + (reverse (sort (delete-duplicates (append (hash-table-keys src-hash) (hash-table-keys dest-hash))) - (lambda (a b) - (if (= -1 (string-compare3 (car a) (car b))) - #t - (if (= -1 (string-compare3 (cdr a) (cdr b))) - #t - #f)))))) - (pretty-print all-keys) + + (lambda (a b) + (cond + ((< 0 (string-compare3 (car a) (car b))) #t) + ((> 0 (string-compare3 (car a) (car b))) #f) + ((< 0 (string-compare3 (cdr a) (cdr b))) #t) + (else #f))) + + )))) (map ;; TODO: rename xor to delta globally in dcommon and dashboard (lambda (key) (let* ((test-name (car key)) (item-path (cdr key)) @@ -343,15 +345,15 @@ (incomplete-statuses '("DELETED" "INCOMPLETE" "STUCK/DEAD" "N/A")) ;; if any of these statuses apply, treat test as incomplete (dest-complete (and dest-value dest-state dest-status - (equal? dest-state "COMPLETE") + (equal? dest-state "COMPLETED") (not (member dest-status incomplete-statuses)))) (src-complete (and src-value src-state src-status - (equal? src-state "COMPLETE") + (equal? src-state "COMPLETED") (not (member src-status incomplete-statuses)))) (status-compare-result (dcommon:status-compare3 src-status dest-status)) (xor-new-item (cond ;; complete, for this case means: state=compelte AND status not in ( deleted uncomplete stuck/dead n/a ) @@ -365,11 +367,11 @@ ((not src-complete) (list dest-test-id "DIFF-NEW" "SRC-INCOMPLETE")) ((and (equal? src-state dest-state) (equal? src-status dest-status)) - (list dest-test-id dest-state (conc "CLEAN:" dest-status) )) + (list dest-test-id (conc "CLEAN") (conc "CLEAN-" dest-status) )) ;; better or worse: pass > warn > waived > skip > fail > abort ;; pass > warn > waived > skip > fail > abort ((= 1 status-compare-result) ;; src is better, dest is worse (list dest-test-id "DIRTY-WORSE" (conc src-status "->" dest-status))) Index: gutils.scm ================================================================== --- gutils.scm +++ gutils.scm @@ -41,10 +41,15 @@ ;; '("70 249 73" "PASS") ;; (if (or (equal? status "WARN") ;; (equal? status "WAIVED")) ;; (list "255 172 13" status) ;; (list "223 33 49" status)))) ;; greenish orangeish redish + + ((CLEAN) (list "60 235 63" status)) + ((DIRTY-BETTER) (list "160 255 153" status)) + ((DIRTY-WORSE) (list "165 42 42" status)) + ((BOTH-BAD) (list "253 33 49" state)) ((LAUNCHED) (list "101 123 142" state)) ((CHECK) (list "255 100 50" state)) ((REMOTEHOSTSTART) (list "50 130 195" state)) ((RUNNING) (list "9 131 232" state)) ((KILLREQ) (list "39 82 206" state))