105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
(define (rmt:open-test-db-by-test-id test-id #!key (work-area #f))
(let* ((test-path (if (string? work-area)
work-area
(rmt:test-get-rundir-from-test-id test-id))))
(debug:print 3 "TEST PATH: " test-path)
(open-test-db test-path)))
(define (rmt:testmeta-get-record testname)
(list->vector
(rmt:send-receive 'testmeta-get-record (list testname))))
|
<
<
<
<
|
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
(define (rmt:open-test-db-by-test-id test-id #!key (work-area #f))
(let* ((test-path (if (string? work-area)
work-area
(rmt:test-get-rundir-from-test-id test-id))))
(debug:print 3 "TEST PATH: " test-path)
(open-test-db test-path)))
;; WARNING: This currently bypasses the transaction wrapped writes system
(define (rmt:test-set-state-status-by-id test-id newstate newstatus newcomment)
(rmt:send-receive 'test-set-state-status-by-id (list test-id newstate newstatus newcomment)))
(define (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus)
(rmt:send-receive 'set-tests-state-status (list run-id testnames currstate currstatus newstate newstatus)))
|
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
(vector hedr (map list->vector data))))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit)
(let* ((res (rmt:send-receive 'get-runs-by-patt (list runpatt count offset keypatts)))
(hedr (car res))
(data (cadr res)))
(vector hedr (map list->vector data))))
|
|
>
>
>
>
>
>
|
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
(vector hedr (map list->vector data))))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit)
(let* ((res (rmt:send-receive 'get-runs-by-patt (list runpatt count offset keypatts)))
(hedr (car res))
(data (cadr res)))
(vector hedr (map list->vector data))))
(define (rmt:lock/unlock-run run-id lock unlock user)
(rmt:send-receive 'lock/unlock-run (list run-id lock unlock user)))
(define (rmt:update-run-event_time run-id)
(rmt:send-receive 'update-run-event_time (list run-id)))
;;======================================================================
;; S T E P S
;;======================================================================
;; Getting steps is more complicated.
;;
;; If given work area
|
237
238
239
240
241
242
243
|
;;======================================================================
(define (rmt:read-test-data test-id categorypatt #!key (work-area #f))
(let ((tdb (rmt:open-test-db-by-test-id test-id work-area: work-area)))
(if tdb
(tdb:read-test-data tdb test-id categorypatt)
'())))
|
>
>
>
>
>
>
>
>
>
>
|
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
;;======================================================================
(define (rmt:read-test-data test-id categorypatt #!key (work-area #f))
(let ((tdb (rmt:open-test-db-by-test-id test-id work-area: work-area)))
(if tdb
(tdb:read-test-data tdb test-id categorypatt)
'())))
(define (rmt:testmeta-add-record testname)
(rmt:send-receive 'testmeta-add-record (list testname)))
(define (rmt:testmeta-get-record testname)
(list->vector
(rmt:send-receive 'testmeta-get-record (list testname))))
(define (rmt:testmeta-update-field test-name fld val)
(rmt:send-receive 'testmeta-update-field (list test-name fld val)))
|