11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
;; #;; (rmt:get-test-info-by-id run-id test-id)
;; #;; (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode)
;; megatest -repl << EOF
;; TODO:dashboard not on homehost message exit
(define (run-name->run-id runname)
(let* ((qry-res (rmt:get-runs runname 1 0 '())))
(if (eq? 2 (vector-length qry-res))
(vector-ref (car (vector-ref qry-res 1)) 1)
#f)))
(define (run-name->test-ht runname)
(let* ((ht (make-hash-table))
(run-id (run-name->run-id runname))
(testpatt "%/%")
(states '("COMPLETED" "INCOMPLETE"))
(statuses '("PASS" "FAIL" "ABORT" "SKIP"))
(offset #f)
(limit #f)
(not-in #f)
(sort-by #f)
(sort-order #f)
(qryvals "id,testname,item_path,state,status")
(last-update 0)
(mode #f)
)
(print run-id)
(print (rmt:get-tests-for-run run-id
testpatt states statuses
offset limit
not-in sort-by sort-order
qryvals
last-update
mode))
;(print (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in "%" "%" #f "id,testname,testpath,state,status" 0 'normal))
;(print run-id)
))
(run-name->test-ht "all57")
;;(exit)
;;EOF
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
|
|
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
>
|
|
|
>
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
;; #;; (rmt:get-test-info-by-id run-id test-id)
;; #;; (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode)
;; megatest -repl << EOF
;; TODO:dashboard not on homehost message exit
(define (tests-mindat->hash tests-mindat)
(let* ((res (make-hash-table)))
(for-each
(lambda (item)
(let* ((test-name+item-path (cons (list-ref item 0) (list-ref item 1)))
(value (list-ref item 2)))
(hash-table-set! res test-name+item-path value)))
tests-mindat)
res))
;; return 1 if status1 is better
;; return 0 if status1 and 2 are equally good
;; return -1 if status2 is better
(define (status-compare3 status1 status2)
(let*
((status-goodness-ranking (list "PASS" "WARN" "WAIVED" "SKIP" "FAIL" "ABORT" #f))
(mem1 (member status1 status-goodness-ranking))
(mem2 (member status2 status-goodness-ranking))
)
(cond
((and (not mem1) (not mem2)) 0)
((not mem1) -1)
((not mem2) 1)
((= (length mem1) (length mem2)) 0)
((> (length mem1) (length mem2)) 1)
(else -1))))
(define (xor-tests-mindat src-tests-mindat dest-tests-mindat #!key (hide-clean #f))
(let* ((src-hash (tests-mindat->hash src-tests-mindat))
(dest-hash (tests-mindat->hash dest-tests-mindat))
(all-keys
(reverse (sort
(delete-duplicates
(append (hash-table-keys src-hash) (hash-table-keys dest-hash)))
(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)))
))))
(let ((res
(map ;; TODO: rename xor to delta globally in dcommon and dashboard
(lambda (key)
(let* ((test-name (car key))
(item-path (cdr key))
(dest-value (hash-table-ref/default dest-hash key #f)) ;; (list test-id state status)
(dest-test-id (if dest-value (list-ref dest-value 0) #f))
(dest-state (if dest-value (list-ref dest-value 1) #f))
(dest-status (if dest-value (list-ref dest-value 2) #f))
(src-value (hash-table-ref/default src-hash key #f)) ;; (list test-id state status)
(src-test-id (if src-value (list-ref src-value 0) #f))
(src-state (if src-value (list-ref src-value 1) #f))
(src-status (if src-value (list-ref src-value 2) #f))
(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 "COMPLETED")
(not (member dest-status incomplete-statuses))))
(src-complete
(and src-value src-state src-status
(equal? src-state "COMPLETED")
(not (member src-status incomplete-statuses))))
(status-compare-result (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 )
;; neither complete -> bad
;; src !complete, dest complete -> better
((and (not dest-complete) (not src-complete))
(list dest-test-id "BOTH-BAD" "BOTH-INCOMPLETE"))
((not dest-complete)
(list src-test-id "DIFF-MISSING" "DEST-INCOMPLETE"))
((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 (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)))
(else
(list dest-test-id "DIRTY-BETTER" (conc src-status "->" dest-status)))
)))
(list test-name item-path xor-new-item)))
all-keys)))
(if hide-clean
(filter
(lambda (item)
;;(print item)
(not
(equal?
"CLEAN"
(list-ref (list-ref item 2) 1))))
res)
res))))
(define (run-name->run-id runname)
(let* ((qry-res (rmt:get-runs runname 1 0 '())))
(if (eq? 2 (vector-length qry-res))
(vector-ref (car (vector-ref qry-res 1)) 1)
#f)))
(define (run-name->tests-mindat runname)
(let* ((run-id (run-name->run-id runname))
(testpatt "%/%")
;; (states '("COMPLETED" "INCOMPLETE"))
;; (statuses '("PASS" "FAIL" "ABORT" "SKIP"))
(states '())
(statuses '())
(offset #f)
(limit #f)
(not-in #t)
(sort-by #f)
(sort-order #f)
(qryvals "id,testname,item_path,state,status")
(qryvals "id,testname,item_path,state,status")
(last-update 0)
(mode #f)
)
(print run-id)
(map
(lambda (row)
(let* ((id (vector-ref row 0))
(test-name (vector-ref row 1))
(item-path (vector-ref row 2))
(state (vector-ref row 3))
(status (vector-ref row 4)))
;;(hash-table-set! ht (cons testname item_path) (list id state status))
(list test-name item-path (list id state status))
;;(print testname id))
))
(rmt:get-tests-for-run run-id
testpatt states statuses
offset limit
not-in sort-by sort-order
qryvals
last-update
mode))
;(print (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in "%" "%" #f "id,testname,testpath,state,status" 0 'normal))
;(print run-id)
))
(print (run-name->tests-mindat "all60"))
(let* ((src-tests-mindat (run-name->tests-mindat "all57"))
(dest-tests-mindat (run-name->tests-mindat "all60")))
(print (xor-tests-mindat src-tests-mindat dest-tests-mindat)));; #!key (hide-clean #f))
;;(exit)
;;EOF
|