Overview
| Comment: | Reverted register-test to not be remote in test1 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | test-specific-db |
| Files: | files | file ages | folders |
| SHA1: |
fb07933d2aea3419551fe2d7b478df1e |
| User & Date: | matt on 2012-10-06 14:25:49 |
| Other Links: | branch diff | manifest | tags |
Context
|
2012-10-06
| ||
| 16:40 | rpc working on Ubuntu except for rollup check-in: 6747bc6633 user: matt tags: test-specific-db | |
| 14:25 | Reverted register-test to not be remote in test1 check-in: fb07933d2a user: matt tags: test-specific-db | |
|
2012-10-05
| ||
| 17:04 | Backed out rpc of register-test, test1,test4 working check-in: 197b642483 user: mrwellan tags: test-specific-db | |
Changes
Modified db.scm from [a453d29161] to [dfb1bb5681].
| ︙ | ︙ | |||
1071 1072 1073 1074 1075 1076 1077 |
(list fail-count pass-count test-id))
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if *cache-on*
(debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write")
(db:write-cached-data)))
| | | 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 |
(list fail-count pass-count test-id))
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if *cache-on*
(debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write")
(db:write-cached-data)))
(define (cdb:tests-register-test db run-id test-name item-path #!key (force-write #f))
(let ((item-paths (if (equal? item-path "")
(list item-path)
(list item-path ""))))
(debug:print 4 "INFO: Adding " run-id ", " test-name "/" item-path " for setting pass/fail counts to the queue")
(mutex-lock! *incoming-mutex*)
(set! *last-db-access* (current-seconds))
(set! *incoming-data* (cons (vector 'register-test
|
| ︙ | ︙ | |||
1646 1647 1648 1649 1650 1651 1652 |
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:pass-fail-counts host port) test-id fail-count pass-count))
(cdb:pass-fail-counts test-id fail-count pass-count)))
;; currently forces a flush of the queue
| | | | | 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 |
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:pass-fail-counts host port) test-id fail-count pass-count))
(cdb:pass-fail-counts test-id fail-count pass-count)))
;; currently forces a flush of the queue
(define (rdb:tests-register-test db run-id test-name item-path)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:tests-register-test host port) db run-id test-name item-path force-write: #t))
(cdb:tests-register-test db run-id test-name item-path force-write: #t)))
(define (rdb:flush-queue)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:flush-queue host port)))
(cdb:flush-queue)))
|
Modified server.scm from [16954f9f6c] to [69a1ff5b72].
| ︙ | ︙ | |||
61 62 63 64 65 66 67 | ;; can use this to run most anything at the remote (rpc:publish-procedure! 'remote:run (lambda (procstr . params) (server:autoremote procstr params))) (rpc:publish-procedure! | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | ;; can use this to run most anything at the remote (rpc:publish-procedure! 'remote:run (lambda (procstr . params) (server:autoremote procstr params))) (rpc:publish-procedure! 'server:login (lambda (toppath) (set! *last-db-access* (current-seconds)) (if (equal? *toppath* toppath) (begin (debug:print 2 "INFO: login successful") #t) #f))) |
| ︙ | ︙ | |||
101 102 103 104 105 106 107 | 'cdb:pass-fail-counts (lambda (test-id fail-count pass-count) (debug:print 4 "INFO: Remote call of cdb:pass-fail-counts " test-id " passes: " pass-count " fails: " fail-count) (cdb:pass-fail-counts test-id fail-count pass-count))) (rpc:publish-procedure! 'cdb:tests-register-test | | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 | 'cdb:pass-fail-counts (lambda (test-id fail-count pass-count) (debug:print 4 "INFO: Remote call of cdb:pass-fail-counts " test-id " passes: " pass-count " fails: " fail-count) (cdb:pass-fail-counts test-id fail-count pass-count))) (rpc:publish-procedure! 'cdb:tests-register-test (lambda (db run-id test-name item-path) (debug:print 4 "INFO: Remote call of cdb:tests-register-test " run-id " testname: " test-name " item-path: " item-path) (cdb:tests-register-test db run-id test-name item-path))) (rpc:publish-procedure! 'cdb:flush-queue (lambda () (debug:print 4 "INFO: Remote call of cdb:flush-queue") (cdb:flush-queue))) |
| ︙ | ︙ | |||
193 194 195 196 197 198 199 | (debug:print 0 " EXCEPTION: " ((condition-property-accessor 'exn 'message) exn)) ;; (open-run-close ;; (lambda (db . param) ;; (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'")) ;; #f) (set! *runremote* #f)) (if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server | | | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | (debug:print 0 " EXCEPTION: " ((condition-property-accessor 'exn 'message) exn)) ;; (open-run-close ;; (lambda (db . param) ;; (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'")) ;; #f) (set! *runremote* #f)) (if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server ((rpc:procedure 'server:login host portn) *toppath*)) (begin (debug:print 2 "INFO: Connected to " host ":" port) (set! *runremote* (vector host portn))) (begin (debug:print 2 "INFO: Failed to connect to " host ":" port) (set! *runremote* #f))))) (debug:print 2 "INFO: no server available"))))) |
Modified tests/tests.scm from [a5186d2c56] to [1e0027e171].
| ︙ | ︙ | |||
188 189 190 191 192 193 194 | (vector-ref (hash-table-ref (db:get-steps-table db test-id) "step1") 4))) ;;====================================================================== ;; R E M O T E C A L L S ;;====================================================================== ;; start a server process | > | | | | 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 |
(vector-ref (hash-table-ref (db:get-steps-table db test-id) "step1") 4)))
;;======================================================================
;; R E M O T E C A L L S
;;======================================================================
;; start a server process
(set! *verbosity* 10)
(define server-pid (process-run "../../bin/megatest" (list "-server" "-" "-debug" (conc *verbosity*))))
(sleep 2)
(define start-wait (current-seconds))
(server:client-setup)
(print "Starting intensive cache and rpc test")
(for-each (lambda (params)
;;; (rdb:tests-register-test #f 1 (conc "test" (random 20)) "")
(apply rdb:test-set-status-state test-id params)
(rdb:pass-fail-counts test-id (random 100) (random 100))
(rdb:test-rollup-iterated-pass-fail test-id)
(thread-sleep! 0.01)) ;; cache ordering granularity is at the second level. Should really be at the ms level
'(("COMPLETED" "PASS" #f)
("NOT_STARTED" "FAIL" "Just testing")
("NOT_STARTED" "FAIL" "Just testing")
|
| ︙ | ︙ |