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
|
;; T E S T S
;;======================================================================
(define (rmt:get-test-id run-id testname item-path)
(rmt:send-receive 'get-test-id (list run-id testname item-path)))
(define (rmt:get-test-info-by-id run-id test-id)
(rmt:send-receive 'get-test-info-by-id (list run-id test-id)))
(define (rmt:test-get-rundir-from-test-id run-id test-id)
(rmt:send-receive 'test-get-rundir-from-test-id (list run-id test-id)))
(define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
(let* ((test-path (if (string? work-area)
work-area
(rmt:test-get-rundir-from-test-id run-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 run-id test-id newstate newstatus newcomment)
(rmt:send-receive 'test-set-state-status-by-id (list run-id 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)))
(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)
(rmt:send-receive 'get-tests-for-run (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)))
(define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
(rmt:send-receive 'get-tests-for-runs-mindata (list run-ids testpatt states status not-in)))
(define (rmt:delete-test-records run-id test-id)
(rmt:send-receive 'delete-test-records (list run-id test-id)))
|
>
|
>
>
>
>
>
|
>
>
>
>
|
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
|
;; T E S T S
;;======================================================================
(define (rmt:get-test-id run-id testname item-path)
(rmt:send-receive 'get-test-id (list run-id testname item-path)))
(define (rmt:get-test-info-by-id run-id test-id)
(if (and (number? run-id)(number? test-id))
(rmt:send-receive 'get-test-info-by-id (list run-id test-id))
(begin
(debug:print 0 "ERROR: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
(print-call-chain)
#f)))
(define (rmt:test-get-rundir-from-test-id run-id test-id)
(rmt:send-receive 'test-get-rundir-from-test-id (list run-id test-id)))
(define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
(let* ((test-path (if (string? work-area)
work-area
(rmt:test-get-rundir-from-test-id run-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 run-id test-id newstate newstatus newcomment)
(rmt:send-receive 'test-set-state-status-by-id (list run-id 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)))
(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)
(if (number? run-id)
(rmt:send-receive 'get-tests-for-run (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals))
(begin
(debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id)
(print-call-chain)
'())))
(define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
(rmt:send-receive 'get-tests-for-runs-mindata (list run-ids testpatt states status not-in)))
(define (rmt:delete-test-records run-id test-id)
(rmt:send-receive 'delete-test-records (list run-id test-id)))
|
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
;; If not given the work area
;; 1. Do a remote call to get the test path
;; 2. Continue as above
;;
(define (rmt:get-steps-for-test test-id)
(rmt:send-receive 'get-steps-data (list test-id)))
(define (rmt:teststep-set-status! test-id teststep-name state-in status-in comment logfile)
(let* ((state (items:check-valid-items "state" state-in))
(status (items:check-valid-items "status" status-in)))
(if (or (not state)(not status))
(debug:print 3 "WARNING: Invalid " (if status "status" "state")
" value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
(rmt:send-receive 'teststep-set-status! (list test-id teststep-name state-in status-in comment logfile))))
(define (rmt:get-steps-for-test test-id)
(rmt:send-receive 'get-steps-for-test (list test-id)))
;;======================================================================
;; T E S T D A T A
;;======================================================================
|
|
|
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
|
;; If not given the work area
;; 1. Do a remote call to get the test path
;; 2. Continue as above
;;
(define (rmt:get-steps-for-test test-id)
(rmt:send-receive 'get-steps-data (list test-id)))
(define (rmt:teststep-set-status! run-id test-id teststep-name state-in status-in comment logfile)
(let* ((state (items:check-valid-items "state" state-in))
(status (items:check-valid-items "status" status-in)))
(if (or (not state)(not status))
(debug:print 3 "WARNING: Invalid " (if status "status" "state")
" value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
(rmt:send-receive 'teststep-set-status! (list run-id test-id teststep-name state-in status-in comment logfile))))
(define (rmt:get-steps-for-test test-id)
(rmt:send-receive 'get-steps-for-test (list test-id)))
;;======================================================================
;; T E S T D A T A
;;======================================================================
|
261
262
263
264
265
266
267
268
269
|
(define (rmt:testmeta-update-field test-name fld val)
(rmt:send-receive 'testmeta-update-field (list test-name fld val)))
(define (rmt:test-data-rollup run-id test-id status)
(rmt:send-receive 'test-data-rollup (list run-id test-id status)))
(define (rmt:csv->test-data test-id csvdata)
(rmt:send-receive 'csv->test-data (list test-id csvdata)))
|
|
|
|
271
272
273
274
275
276
277
278
279
|
(define (rmt:testmeta-update-field test-name fld val)
(rmt:send-receive 'testmeta-update-field (list test-name fld val)))
(define (rmt:test-data-rollup run-id test-id status)
(rmt:send-receive 'test-data-rollup (list run-id test-id status)))
(define (rmt:csv->test-data run-id test-id csvdata)
(rmt:send-receive 'csv->test-data (list run-id test-id csvdata)))
|