49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
(conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
;; for each run starting with the most recent look to see if there is a matching test
;; if found then return that matching test record
(debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids)
(if (null? prev-run-ids) #f
(let loop ((hed (car prev-run-ids))
(tal (cdr prev-run-ids)))
(let ((results (rdb:get-tests-for-run db hed test-name item-path '() '())))
(debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
(if (and (null? results)
(not (null? tal)))
(loop (car tal)(cdr tal))
(if (null? results) #f
(car results))))))))))
|
|
|
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
(conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
;; for each run starting with the most recent look to see if there is a matching test
;; if found then return that matching test record
(debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids)
(if (null? prev-run-ids) #f
(let loop ((hed (car prev-run-ids))
(tal (cdr prev-run-ids)))
(let ((results (db:get-tests-for-run db hed test-name item-path '() '())))
(debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
(if (and (null? results)
(not (null? tal)))
(loop (car tal)(cdr tal))
(if (null? results) #f
(car results))))))))))
|
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
(hash-table-set! tests-hash full-testname testdat))))
results)
(if (null? tal)
(map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
(loop (car tal)(cdr tal))))))))))
;;
(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
(let* ((real-status status)
(item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
(testdat (rdb:get-test-info db run-id test-name item-path))
(test-id (if testdat (db:test-get-id testdat) #f))
|
|
<
<
<
>
>
>
>
|
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
(hash-table-set! tests-hash full-testname testdat))))
results)
(if (null? tal)
(map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
(loop (car tal)(cdr tal))))))))))
;;
(define (test-set-status! db test-id state status comment dat)
(let* ((real-status status)
(otherdat (if dat dat (make-hash-table)))
(testdat (db:get-test-data-by-id db test-id))
(run-id (db:test-get-run_id testdat))
(test-name (db:test-get-testname testdat))
(item-path (db:test-get-item-path testdat))
;; before proceeding we must find out if the previous test (where all keys matched except runname)
;; was WAIVED if this test is FAIL
(waived (if (equal? status "FAIL")
(let ((prev-test (test:get-previous-test-run-record db run-id test-name item-path)))
(if prev-test ;; true if we found a previous test in this run series
(let ((prev-status (db:test-get-status prev-test))
(prev-state (db:test-get-state prev-test))
|
384
385
386
387
388
389
390
391
392
393
394
395
396
|
(define (rtests:register-test db run-id test-name item-path)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rtests:register-test host port) run-id test-name item-path))
(tests:register-test db run-id test-name item-path)))
(define (rtests:test-set-status! db run-id test-name state status itemdat-or-path comment dat)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rtests:test-set-status! host port) run-id test-name state status itemdat-or-path comment dat))
(test-set-status! db run-id test-name state status itemdat-or-path comment dat)))
|
|
|
|
|
385
386
387
388
389
390
391
392
393
394
395
396
397
|
(define (rtests:register-test db run-id test-name item-path)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rtests:register-test host port) run-id test-name item-path))
(tests:register-test db run-id test-name item-path)))
(define (rtests:test-set-status! db test-id state status comment dat)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rtests:test-set-status! host port) test-id state status comment dat))
(test-set-status! db test-id state status comment dat)))
|