Overview
Comment: | Added next round of tests |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
Files: | files | file ages | folders |
SHA1: |
bda352d54b2f903376bd94ab6581a903 |
User & Date: | matt on 2021-05-11 05:34:11 |
Other Links: | branch diff | manifest | tags |
Context
2021-05-11
| ||
22:39 | wip check-in: 41b511ca4f user: matt tags: v1.6584-ck5 | |
05:34 | Added next round of tests check-in: bda352d54b user: matt tags: v1.6584-ck5 | |
2021-05-10
| ||
23:25 | Ripped up and rebuilt (but not completed) send-recieve check-in: 60d056bd58 user: matt tags: v1.6584-ck5 | |
Changes
Modified http-transportmod.scm from [1c967146dc] to [b05b0793f5].
︙ | ︙ | |||
305 306 307 308 309 310 311 | (mutex-lock! *http-mutex*) (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*))) ;; serverdat contains uuid to be used for connection validation ;; ;; NOTE: serverdat must be initialized or created by servdat-init ;; | | | 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 | (mutex-lock! *http-mutex*) (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*))) ;; serverdat contains uuid to be used for connection validation ;; ;; NOTE: serverdat must be initialized or created by servdat-init ;; #;(define (http-transport:send-receive sdat qry-key cmd params #!key (numretries 3)) (let* ((res #f) (success #t) (sparams (with-output-to-string (lambda ()(write params))))) ;; send the data and get the response extract the needed info from ;; the http data and process and return it. (let* ((send-recieve (lambda () |
︙ | ︙ |
Modified rmtmod.scm from [dc42b6de0a] to [793347499a].
︙ | ︙ | |||
46 47 48 49 50 51 52 53 54 55 56 57 58 59 | chicken.base chicken.file chicken.format chicken.process chicken.file.posix chicken.process-context.posix chicken.process-context (prefix sqlite3 sqlite3:) typed-records srfi-1 srfi-13 srfi-18 srfi-69 | > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | chicken.base chicken.file chicken.format chicken.process chicken.file.posix chicken.process-context.posix chicken.process-context chicken.io (prefix sqlite3 sqlite3:) typed-records srfi-1 srfi-13 srfi-18 srfi-69 |
︙ | ︙ | |||
238 239 240 241 242 243 244 | (let ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f)))) (if (not mainconn) (begin (rmt:open-main-connection remote apath) (thread-sleep! 1) (rmt:general-open-connection remote apath dbname)) ;; we have a connection to main, ask for contact info for dbname | | | 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 | (let ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f)))) (if (not mainconn) (begin (rmt:open-main-connection remote apath) (thread-sleep! 1) (rmt:general-open-connection remote apath dbname)) ;; we have a connection to main, ask for contact info for dbname (let* ((res (rmt:send-receive-real remote apath ".db/main.db" #f 'get-server `(,apath ,dbname)))) (print "rmt:general-open-connection got res="res))))) ;;====================================================================== ;; Defaults to ;; |
︙ | ︙ | |||
266 267 268 269 270 271 272 | (let* ((host (rmt:conn-ipaddr conn)) (port (rmt:conn-port conn)) (payload (sexpr->string params)) (res (with-input-from-request (conc "http://"host":"port"/api") `((params . ,payload) (cmd . ,cmd) | | | | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | (let* ((host (rmt:conn-ipaddr conn)) (port (rmt:conn-port conn)) (payload (sexpr->string params)) (res (with-input-from-request (conc "http://"host":"port"/api") `((params . ,payload) (cmd . ,cmd) (key . "nokey")) read-string))) (string->sexpr res)))) (define (rmt:print-db-stats) (let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f" (debug:print 18 *default-log-port* "DB Stats\n========") (debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg")) (for-each (lambda (cmd) |
︙ | ︙ | |||
1539 1540 1541 1542 1543 1544 1545 | ;; called in megatest.scm, host-port is string hostname:port ;; ;; NOTE: This is NOT called directly from clients as not all transports support a client running ;; in the same process as the server. ;; (define (server:ping host port server-id #!key (do-exit #f)) (let* ((sdat (servdat-init #f host port server-id))) | | | 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 | ;; called in megatest.scm, host-port is string hostname:port ;; ;; NOTE: This is NOT called directly from clients as not all transports support a client running ;; in the same process as the server. ;; (define (server:ping host port server-id #!key (do-exit #f)) (let* ((sdat (servdat-init #f host port server-id))) (rmt:send-receive sdat 'ping '()))) ;; ping the given server ;; (define (server:check-server server-record) (let* ((server-url (server:record->url server-record)) (server-id (server:record->id server-record)) (res (server:ping server-url server-id))) |
︙ | ︙ |
Modified tests/unittests/basicserver.scm from [6df38336e6] to [668f0a5656].
︙ | ︙ | |||
18 19 20 21 22 23 24 | ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; Run like this: ;; ;; ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) | | > > > > > > > > > | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; Run like this: ;; ;; ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) (import rmtmod trace http-transportmod http-client apimod) (trace-call-sites #t) (trace ;; rmt:find-main-server ) (test #f #t (rmt:remote? (let ((r (make-rmt:remote))) (set! *rmt:remote* r) r))) (test #f #f (rmt:get-connection *rmt:remote* *toppath* ".db/main.db")) (test #f #f (rmt:find-main-server *toppath* ".db/main.db")) (test #f #t (rmt:open-main-connection *rmt:remote* *toppath*)) (pp (hash-table->alist (rmt:remote-conns *rmt:remote*))) (test #f #t (rmt:conn? (rmt:get-connection *rmt:remote* *toppath* ".db/main.db"))) (define *main* (rmt:get-connection *rmt:remote* *toppath* ".db/main.db")) (test #f 'a (loop-test (rmt:conn-ipaddr *main*)(rmt:conn-port *main*) 'a)) (trace rmt:get-connection with-input-from-request ) (define *db* #f) (test #f #f (api:execute-requests *db* 'get-server `(,*toppath* ".db/1.db"))) (test #f #f (rmt:general-open-connection *rmt:remote* *toppath* ".db/1.db")) ;; (delete-file* "logs/1.log") ;; (define run-id 1) ;; (test "setup for run" #t (begin (launch:setup) ;; (string? (getenv "MT_RUN_AREA_HOME")))) ;; |
︙ | ︙ |