123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
-
-
-
+
+
+
+
|
res
(cons testn res)))))))))
;;======================================================================
;; T R I G G E R S
;;======================================================================
(define (mt:process-triggers test-id newstate newstatus)
(let* ((test-dat (rmt:get-test-info-by-id test-id))
(test-rundir (filedb:get-path *fdb* (db:test-get-rundir test-dat)))
(define (mt:process-triggers run-id test-id newstate newstatus)
(let* ((test-dat (rmt:get-test-info-by-id run-id test-id))
(test-rundir ;; (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))))
(if (and (file-exists? test-rundir)
(directory? test-rundir))
(begin
|
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
-
+
|
(rmt:general-call 'state-status-msg run-id newstate newstatus newcomment test-id))
((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))))
(mt:process-triggers test-id newstate newstatus)
(mt:process-triggers run-id test-id newstate newstatus)
#t)
(define (mt:lazy-get-test-info-by-id test-id)
(let* ((tdat (hash-table-ref/default *test-info* test-id #f)))
(if (and tdat
(< (current-seconds)(+ (vector-ref tdat 0) 10)))
(vector-ref tdat 1)
|