Overview
| Comment: | Mostly got unit tests working again. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v2.001 |
| Files: | files | file ages | folders |
| SHA1: |
c7197c92dd445b0846fa791e0b98bb5e |
| User & Date: | matt on 2021-12-14 20:05:11 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-12-18
| ||
| 05:45 | WIP - doesn't compile check-in: 9607b06dff user: matt tags: v2.001 | |
|
2021-12-14
| ||
| 20:05 | Mostly got unit tests working again. check-in: c7197c92dd user: matt tags: v2.001 | |
|
2021-12-13
| ||
| 19:56 | Fixed bunch of issues with main.db server startup. check-in: c423bc098e user: matt tags: v2.001 | |
Changes
Modified apimod.scm from [e18f34d37e] to [90c616c280].
| ︙ | ︙ | |||
202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
;; SERVERS
;; ((start-server) (apply server:kind-run params))
((kill-server) (set! *server-run* #f))
((get-server) (api:start-server dbstruct params))
((register-server) (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((deregister-server) (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((get-count-servers) (apply db:get-count-servers dbstruct params))
;; TESTS
;;((test-set-state-status-by-id) (apply mt:test-set-state-status-by-id dbstruct params))
| > | 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 |
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
;; SERVERS
;; ((start-server) (apply server:kind-run params))
((kill-server) (set! *server-run* #f))
((get-server) (api:start-server dbstruct params))
((get-server-info) (apply db:get-server-info dbstruct params))
((register-server) (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((deregister-server) (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((get-count-servers) (apply db:get-count-servers dbstruct params))
;; TESTS
;;((test-set-state-status-by-id) (apply mt:test-set-state-status-by-id dbstruct params))
|
| ︙ | ︙ |
Modified rmtmod.scm from [a1b386ab00] to [ae314078d9].
| ︙ | ︙ | |||
410 411 412 413 414 415 416 417 418 419 420 421 422 423 | (define (rmt:kill-server run-id) (rmt:send-receive 'kill-server run-id (list run-id))) (define (rmt:start-server run-id) (rmt:send-receive 'start-server 0 (list run-id))) ;;====================================================================== ;; M I S C ;;====================================================================== (define (rmt:login run-id) (rmt:send-receive 'login run-id (list *toppath* megatest-version *my-signature*))) | > > > | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 | (define (rmt:kill-server run-id) (rmt:send-receive 'kill-server run-id (list run-id))) (define (rmt:start-server run-id) (rmt:send-receive 'start-server 0 (list run-id))) (define (rmt:get-server-info apath dbname) (rmt:send-receive 'get-server-info 0 (list 0 apath dbname))) ;;====================================================================== ;; M I S C ;;====================================================================== (define (rmt:login run-id) (rmt:send-receive 'login run-id (list *toppath* megatest-version *my-signature*))) |
| ︙ | ︙ | |||
1679 1680 1681 1682 1683 1684 1685 |
(servdat-trynum-set! *server-info*
(+ (servdat-trynum *server-info*) 1)))
(set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
(debug:print-info 0 *default-log-port* "rmt:try-start-server time="
(seconds->time-string (current-seconds))
" ipaddrsstr=" ipaddrstr
" portnum=" portnum)
| | | | | | | | | | 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 |
(servdat-trynum-set! *server-info*
(+ (servdat-trynum *server-info*) 1)))
(set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
(debug:print-info 0 *default-log-port* "rmt:try-start-server time="
(seconds->time-string (current-seconds))
" ipaddrsstr=" ipaddrstr
" portnum=" portnum)
;;(if (is-port-in-use portnum)
;; (begin
;; (portlogger:open-run-close portlogger:set-failed portnum)
;; (debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
;; ;; (thread-sleep! 0.1)
;; (rmt:try-start-server ipaddrstr
;; (portlogger:open-run-close
;; portlogger:find-port)))
(begin
(if (not *server-info*)
(set! *server-info* (make-servdat
host: ipaddrstr
port: portnum)))
(servdat-status-set! *server-info* 'starting)
(servdat-port-set! *server-info* portnum)
|
| ︙ | ︙ | |||
1717 1718 1719 1720 1721 1722 1723 | (debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port") ;; (thread-sleep! 0.1) (rmt:try-start-server ipaddrstr (portlogger:open-run-close portlogger:find-port))) (begin (print "ERROR: Tried and tried but could not start the server, stopping at port "portnum)))) (nng-listen rep (conc "tcp://*:" portnum)) | | | 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 | (debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port") ;; (thread-sleep! 0.1) (rmt:try-start-server ipaddrstr (portlogger:open-run-close portlogger:find-port))) (begin (print "ERROR: Tried and tried but could not start the server, stopping at port "portnum)))) (nng-listen rep (conc "tcp://*:" portnum)) rep)))) ;;) ;;====================================================================== ;; S E R V E R U T I L I T I E S ;;====================================================================== ;;====================================================================== ;; C L I E N T S |
| ︙ | ︙ | |||
2196 2197 2198 2199 2200 2201 2202 | ;; IFF I'm not main, call into main and register self (if (not is-main) (let ((res (rmt:register-server *rmt:remote* *toppath* iface port server-key dbname))) (if res ;; we are the server (servdat-status-set! *server-info* 'have-interface-and-db) | > > > > | > > > > | | | 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 | ;; IFF I'm not main, call into main and register self (if (not is-main) (let ((res (rmt:register-server *rmt:remote* *toppath* iface port server-key dbname))) (if res ;; we are the server (servdat-status-set! *server-info* 'have-interface-and-db) (let* ((serv-info (rmt:get-server-info *toppath* dbname))) (match serv-info ((host port servkey pid ipaddr apath dbpath) (if (not (server-ready? host port servkey)) (begin (debug:print-info 0 *default-log-port* "Server registered but not alive. Removing and trying again.") (rmt:deregister-server host port servkey pid ipaddr apath dbpath) (loop (+ count 1) bad-sync-count start-time)))) (else (debug:print 0 *default-log-port* "We are not the server for "dbname", exiting. Server info is: "serv-info) (exit))))))) (debug:print 0 *default-log-port* "SERVER: running, db "dbname" opened, megatest version: " (common:get-full-version)) ;; start the watchdog ;; is this really needed? |
| ︙ | ︙ |
Modified tests/tests.scm from [2fa2f9d268] to [7467445dd0].
| ︙ | ︙ | |||
13 14 15 16 17 18 19 |
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
| | > > > > > > > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(import srfi-18
test
chicken.string
chicken.process-context
chicken.file
chicken.pretty-print
commonmod
)
(define test-work-dir (current-directory))
;; given list of lists
;; ( ( msg expected param1 param2 ...)
;; ( ... ) )
;; apply test to all
|
| ︙ | ︙ |