Overview
| Comment: | few more calls converted to api |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
ece438fcbd5c14f919b537b5b32fd08d |
| User & Date: | matt on 2013-11-10 23:28:43 |
| Other Links: | manifest | tags |
Context
|
2013-11-11
| ||
| 06:07 | Added ability to make in-mem db be on disk for debugging check-in: 80dc29f269 user: matt tags: trunk | |
|
2013-11-10
| ||
| 23:28 | few more calls converted to api check-in: ece438fcbd user: matt tags: trunk | |
| 23:21 | 11 out of 30 calls converted to api check-in: d14c539d9a user: matt tags: trunk | |
Changes
Modified api.scm from [90d8ff037f] to [4eb69479d9].
| ︙ | ︙ | |||
34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
((login) (apply db:login db params))
((general-call) (let ((stmtname (car params))
(realparams (cdr params)))
(db:general-call db stmtname realparams)))
((set-tests-state-status) (apply db:set-state-status db params))
((get-tests-for-run) (map vector->list (apply db:get-tests-for-run db params)))
((get-test-id) (apply db:get-test-id-not-cached db params))
(else
(list "ERROR" 0))))
;; http-server send-response
;; api:process-request
;; db:*
;;
| > | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
((login) (apply db:login db params))
((general-call) (let ((stmtname (car params))
(realparams (cdr params)))
(db:general-call db stmtname realparams)))
((set-tests-state-status) (apply db:set-state-status db params))
((get-tests-for-run) (map vector->list (apply db:get-tests-for-run db params)))
((get-test-id) (apply db:get-test-id-not-cached db params))
((get-tests-for-runs-mindata) (map vector->list (apply db:get-tests-for-runs-mindata db params)))
(else
(list "ERROR" 0))))
;; http-server send-response
;; api:process-request
;; db:*
;;
|
| ︙ | ︙ |
Modified rmt.scm from [df44ed0947] to [391f9bbffa].
| ︙ | ︙ | |||
118 119 120 121 122 123 124 125 126 127 128 129 130 131 |
(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)
(map list->vector (rmt:send-receive 'get-tests-for-run (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals))))
;;======================================================================
;; R U N S
;;======================================================================
(define (rmt:get-run-info run-id)
(let ((res (rmt:send-receive 'get-run-info (list run-id))))
(vector (car res)
| > > > | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 |
(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)
(map list->vector (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)
(map list->vector (rmt:send-receive 'get-tests-for-runs-mindata (list run-ids testpatt states status not-in))))
;;======================================================================
;; R U N S
;;======================================================================
(define (rmt:get-run-info run-id)
(let ((res (rmt:send-receive 'get-run-info (list run-id))))
(vector (car res)
|
| ︙ | ︙ |
Modified runs.scm from [dfa1aea477] to [3b532f6305].
| ︙ | ︙ | |||
1048 1049 1050 1051 1052 1053 1054 | ;; NB// for the above line. I want the test to be registered long before this routine gets called! ;; (if (not test-id)(set! test-id (cdb:remote-run db:get-test-id-cached #f run-id test-name item-path))) (if (not test-id) (begin (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id) (rmt:general-call 'tests-register-test run-id test-name item-path) | | | | 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 |
;; NB// for the above line. I want the test to be registered long before this routine gets called!
;;
(if (not test-id)(set! test-id (cdb:remote-run db:get-test-id-cached #f run-id test-name item-path)))
(if (not test-id)
(begin
(debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
(rmt:general-call 'tests-register-test run-id test-name item-path)
(set! test-id (rmt:get-test-id run-id test-name item-path))))
(debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
(set! testdat (rmt:get-test-info-by-id test-id))
(if (not testdat)
(begin
(debug:print-info 0 "WARNING: server is overloaded, trying again in one second")
(thread-sleep! 1)
(loop)))))
(if (not testdat) ;; should NOT happen
(debug:print 0 "ERROR: failed to get test record for test-id " test-id))
|
| ︙ | ︙ | |||
1120 1121 1122 1123 1124 1125 1126 | (let ((skip-test #f) (skip-check (configf:get-section test-conf "skip"))) (cond ;; Have to check for skip conditions. This one skips if there are same-named tests ;; currently running ((and skip-check (configf:lookup test-conf "skip" "prevrunning")) | | | 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 |
(let ((skip-test #f)
(skip-check (configf:get-section test-conf "skip")))
(cond
;; Have to check for skip conditions. This one skips if there are same-named tests
;; currently running
((and skip-check
(configf:lookup test-conf "skip" "prevrunning"))
(let ((running-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f)))
(if (not (null? running-tests)) ;; have to skip
(set! skip-test "Skipping due to previous tests running"))))
((and skip-check
(configf:lookup test-conf "skip" "fileexists"))
(if (file-exists? (configf:lookup test-conf "skip" "fileexists"))
(set! skip-test (conc "Skipping due to existance of file " (configf:lookup test-conf "skip" "fileexists"))))))
(if skip-test
|
| ︙ | ︙ |