Overview
Comment: | Simplify running of unit tests, simplified ping |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
Files: | files | file ages | folders |
SHA1: |
0453b5d22b0b48130ea3498fb96e73f3 |
User & Date: | matt on 2021-05-09 23:42:01 |
Other Links: | branch diff | manifest | tags |
Context
2021-05-10
| ||
22:53 | Got loop-test working check-in: ba4f089eda user: matt tags: v1.6584-ck5 | |
2021-05-09
| ||
23:42 | Simplify running of unit tests, simplified ping check-in: 0453b5d22b user: matt tags: v1.6584-ck5 | |
2021-05-08
| ||
22:47 | Unit test coming along. check-in: 51225a42e5 user: matt tags: v1.6584-ck5 | |
Changes
Modified http-transportmod.scm from [7d98658692] to [853954beaf].
︙ | ︙ | |||
167 168 169 170 171 172 173 | (res #f)) (cond ((equal? (uri-path (request-uri (current-request))) '(/ "api")) (send-response ;; the $ is the request vars proc body: ((api-proc) *dbstruct-db* $) headers: '((content-type text/plain))) | < | > | > > | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 | (res #f)) (cond ((equal? (uri-path (request-uri (current-request))) '(/ "api")) (send-response ;; the $ is the request vars proc body: ((api-proc) *dbstruct-db* $) headers: '((content-type text/plain))) (set! *db-last-access* (current-seconds))) ((equal? (uri-path (request-uri (current-request))) '(/ "ping")) (send-response body: (conc *toppath*"/"(args:get-arg "-db")) headers: '((content-type text/plain)))) ((equal? (uri-path (request-uri (current-request))) '(/ "")) (send-response body: ((http-get-function 'http-transport:main-page)))) ((equal? (uri-path (request-uri (current-request))) '(/ "json_api")) (send-response body: ((http-get-function 'http-transport:main-page)))) ((equal? (uri-path (request-uri (current-request))) |
︙ | ︙ | |||
464 465 466 467 468 469 470 | (read-pkt->alist pkt-file pktspec: pktspec)) all-pkt-files))) (define (server-address srv-pkt) (conc (alist-ref 'host srv-pkt) ":" (alist-ref 'port srv-pkt))) | | | | > > > > > > > > > | | 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | (read-pkt->alist pkt-file pktspec: pktspec)) all-pkt-files))) (define (server-address srv-pkt) (conc (alist-ref 'host srv-pkt) ":" (alist-ref 'port srv-pkt))) (define (server-ready? host port key) ;; server-address is host:port ;; ping the server and ask it ;; if it ready ;; (let* ((sdat (servdat-init #f host port #f))) ;; (http-transport:send-receive sdat "abc" 'ping '()))) (let* ((res (with-input-from-request (conc "http://"host":"port"/ping") ;; returns *toppath*/dbname #f read-string))) (if (equal? res key) #t (begin (debug:print-info 0 *default-log-port* "server-ready? key="key", received="res) #f)))) ;; from the pkts return servers associated with dbpath ;; NOTE: Only one can be alive - have to check on each ;; in the list of pkts returned ;; (define (get-viable-servers serv-pkts dbpath) (let loop ((tail serv-pkts) (res '())) |
︙ | ︙ | |||
491 492 493 494 495 496 497 | ;; from viable servers get one that is alive and ready ;; (define (get-the-server serv-pkts) (let loop ((tail serv-pkts)) (if (null? tail) #f | | | | > | | | 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 | ;; from viable servers get one that is alive and ready ;; (define (get-the-server serv-pkts) (let loop ((tail serv-pkts)) (if (null? tail) #f (let* ((spkt (car tail)) (host (alist-ref 'ipaddr spkt)) (port (alist-ref 'port spkt)) (dbpth (alist-ref 'dbpath spkt)) (addr (server-address spkt))) (if (server-ready? host port dbpth) spkt (loop (cdr tail))))))) ;; am I the "first" in line server? I.e. my D card is smallest ;; use Z card as tie breaker ;; (define (get-best-candidate serv-pkts dbpath) |
︙ | ︙ |
Modified rmtmod.scm from [68e1f7f6c8] to [e114506d72].
︙ | ︙ | |||
203 204 205 206 207 208 209 | (thread-sleep! 1.5) (rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries ))) (if the-srv ;; yes, we have a server, now try connecting to it (let* ((srv-addr (server-address the-srv)) (ipaddr (alist-ref 'ipaddr the-srv)) (port (alist-ref 'port the-srv)) | < | > | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | (thread-sleep! 1.5) (rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries ))) (if the-srv ;; yes, we have a server, now try connecting to it (let* ((srv-addr (server-address the-srv)) (ipaddr (alist-ref 'ipaddr the-srv)) (port (alist-ref 'port the-srv)) (fullpath (db:dbname->path apath dbname)) (srvready (server-ready? ipaddr port fullpath))) (if srvready (begin (hash-table-set! (rmt:remote-conns remote) fullpath (make-rmt:conn apath: apath dbname: dbname |
︙ | ︙ |
Modified tests/Makefile from [b8d7fd37e9] to [f693c2a7e2].
︙ | ︙ | |||
51 52 53 54 55 56 57 | rel : cd release;dashboard -rows 25 & ## basicserver.log : unittests/basicserver.scm ## script -c "./rununittest.sh basicserver $(DEBUG)" basicserver.log | | > | | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | rel : cd release;dashboard -rows 25 & ## basicserver.log : unittests/basicserver.scm ## script -c "./rununittest.sh basicserver $(DEBUG)" basicserver.log %.log : unittests/%.scm ../bin/.*/mtest script -c "./rununittest.sh $* $(DEBUG)" $*.log # if logpro unit.logpro $*.html < $*.log > /dev/null;then echo ALLPASS;else echo ALLFAIL;mv $*.log $*.log.FAIL;fi server : cd fullrun;$(MEGATEST) -server - -debug $(DEBUG) -run-id $(RUNID) stopserver : cd fullrun;$(MEGATEST) -stop-server 0 |
︙ | ︙ |
Modified tests/unittests/basicserver.scm from [0c881772ab] to [e95e668f31].
︙ | ︙ | |||
21 22 23 24 25 26 27 | ;; Run like this: ;; ;; ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) (import rmtmod trace) (trace-call-sites #t) (trace | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | ;; Run like this: ;; ;; ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) (import rmtmod trace) (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")) |
︙ | ︙ |