157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
;; S T A T E A N D S T A T U S F O R T E S T S
;;======================================================================
;; speed up for common cases with a little logic
(define (mt:test-set-state-status-by-id test-id newstate newstatus newcomment)
(cond
((and newstate newstatus newcomment)
(cdb:client-call *runremote* 'state-status-msg #t *default-numtries* newstate newstatus newcomment test-id))
((and newstate newstatus)
(cdb:client-call *runremote* 'state-status #t *default-numtries* newstate newstatus test-id))
(else
(if newstate (cdb:client-call *runremote* 'set-test-state #t *default-numtries* newstate test-id))
(if newstatus (cdb:client-call *runremote* 'set-test-status #t *default-numtries* newstatus test-id))
(if newcomment (cdb:client-call *runremote* 'set-test-comment #t *default-numtries* newcomment test-id))))
(mt:process-triggers 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)))
|
|
|
|
|
|
|
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
;; S T A T E A N D S T A T U S F O R T E S T S
;;======================================================================
;; speed up for common cases with a little logic
(define (mt:test-set-state-status-by-id test-id newstate newstatus newcomment)
(cond
((and newstate newstatus newcomment)
(rmt:general-call 'state-status-msg newstate newstatus newcomment test-id))
((and newstate newstatus)
(rmt:general-call 'state-status newstate newstatus test-id))
(else
(if newstate (rmt:general-call 'set-test-state newstate test-id))
(if newstatus (rmt:general-call 'set-test-status newstatus test-id))
(if newcomment (rmt:general-call 'set-test-comment newcomment test-id))))
(mt:process-triggers 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)))
|