Megatest

Diff
Login

Differences From Artifact [3e2375dcb5]:

To Artifact [ac398979bc]:


105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
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)))

(define (rmt:testmeta-get-record testname)
  (list->vector
   (rmt:send-receive 'testmeta-get-record (list testname))))

;; 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
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










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)))