777
778
779
780
781
782
783
784
785
786
787
788
789
790
|
;; New methodology. These routines will replace the above in time. For
;; now the code is duplicated. This stuff is initially used in the monitor
;; based code.
;;======================================================================
;; register a test run with the db
(define (runs:register-run db keys keyvallst runname state status user)
(let* ((keystr (keys->keystr keys))
(comma (if (> (length keys) 0) "," ""))
(andstr (if (> (length keys) 0) " AND " ""))
(valslots (keys->valslots keys)) ;; ?,?,? ...
(keyvals (map cadr keyvallst))
(allvals (append (list runname state status user) keyvals))
(qryvals (append (list runname) keyvals))
|
>
|
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
|
;; New methodology. These routines will replace the above in time. For
;; now the code is duplicated. This stuff is initially used in the monitor
;; based code.
;;======================================================================
;; register a test run with the db
(define (runs:register-run db keys keyvallst runname state status user)
(debug:print 3 "runs:register-run, keys: " keys " keyvallst: " keyvallst " runname: " runname " state: " state " status: " status " user: " user)
(let* ((keystr (keys->keystr keys))
(comma (if (> (length keys) 0) "," ""))
(andstr (if (> (length keys) 0) " AND " ""))
(valslots (keys->valslots keys)) ;; ?,?,? ...
(keyvals (map cadr keyvallst))
(allvals (append (list runname state status user) keyvals))
(qryvals (append (list runname) keyvals))
|
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
|
(let* ((test-path (conc *toppath* "/tests/" test-name))
(test-configf (conc test-path "/testconfig"))
(testexists (and (file-exists? test-configf)(file-read-access? test-configf)))
;; read configs with tricks turned off (i.e. no system)
(test-conf (if testexists (read-config test-configf #f #f)(make-hash-table))))
(runs:update-test_meta db test-name test-conf)))
test-names)))
(define (runs:rollup-run db keys)
(let* ((new-run-id (register-run db keys))
|
|
|
>
>
|
|
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
|
(let* ((test-path (conc *toppath* "/tests/" test-name))
(test-configf (conc test-path "/testconfig"))
(testexists (and (file-exists? test-configf)(file-read-access? test-configf)))
;; read configs with tricks turned off (i.e. no system)
(test-conf (if testexists (read-config test-configf #f #f)(make-hash-table))))
(runs:update-test_meta db test-name test-conf)))
test-names)))
;; This could probably be refactored into one complex query ...
(define (runs:rollup-run db keys keyvallst runname user) ;; was target, now keyvallst
(debug:print 4 "runs:rollup-run, keys: " keys " keyvallst: " keyvallst " :runname " runname " user: " user)
(let* (; (keyvalllst (keys:target->keyval keys target))
(new-run-id (runs:register-run db keys keyvallst runname "new" "n/a" user))
(prev-tests (test:get-matching-previous-test-run-records db new-run-id "%" "%"))
(curr-tests (db-get-tests-for-run db new-run-id "%" "%" '() '()))
(curr-tests-hash (make-hash-table)))
(db:update-run-event_time db new-run-id)
;; index the already saved tests by testname and itempath in curr-tests-hash
(for-each
(lambda (testdat)
|