126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
-
-
+
+
|
res)
(cons testn res)))))))))
;;======================================================================
;; T R I G G E R S
;;======================================================================
(define (mt:process-triggers run-id test-id newstate newstatus)
(let* ((test-dat (rmt:get-test-info-by-id run-id test-id)))
(define (mt:process-triggers dbstruct run-id test-id newstate newstatus)
(let* ((test-dat (db:get-test-info-by-id dbstruct run-id test-id)))
(if test-dat
(let* ((test-rundir ;; (rmt:sdb-qry 'getstr ;; (filedb:get-path *fdb*
(db:test-get-rundir test-dat)) ;; ) ;; )
(test-name (db:test-get-testname test-dat))
(tconfig #f)
(state (if newstate newstate (db:test-get-state test-dat)))
(status (if newstatus newstatus (db:test-get-status test-dat))))
|
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
-
+
-
+
|
;; ((and newstate newstatus)
;; (rmt:general-call 'state-status run-id newstate newstatus test-id))
;; (else
;; (if newstate (rmt:general-call 'set-test-state run-id newstate test-id))
;; (if newstatus (rmt:general-call 'set-test-status run-id newstatus test-id))
;; (if newcomment (rmt:general-call 'set-test-comment run-id newcomment test-id))))
(rmt:roll-up-pass-fail-counts run-id test-id #f newstate newstatus newcomment)
(mt:process-triggers run-id test-id newstate newstatus)
;; (mt:process-triggers run-id test-id newstate newstatus)
#t)))
(define (mt:test-set-state-status-by-testname run-id test-name item-path new-state new-status new-comment)
(let ((test-id (rmt:get-test-id run-id test-name item-path)))
(rmt:roll-up-pass-fail-counts run-id test-name item-path new-state new-status new-comment)
(mt:process-triggers run-id test-id new-state new-status)
;; (mt:process-triggers run-id test-id new-state new-status)
#t))
;;(mt:test-set-state-status-by-id run-id test-id new-state new-status new-comment)))
(define (mt:lazy-read-test-config test-name)
(let ((tconf (hash-table-ref/default *testconfigs* test-name #f)))
(if tconf
tconf
|