Megatest

Check-in [c7197c92dd]
Login
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: c7197c92dd445b0846fa791e0b98bb5e5cbb0c2e
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
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
	(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)







|
|
|
|
|
|
|
|







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
1724
1725
1726
1727
1728
1729
1730
1731
		   (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







|







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




2203




2204
2205
2206
2207
2208
2209
2210
2211
2212
	      ;; 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)




			(begin 




			  (debug:print 0 *default-log-port* "We are not the server for "dbname", exiting.")
			  (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?
	      







>
>
>
>
|
>
>
>
>
|
|







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
20







21
22
23
24
25
26
27
;;     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)








(define test-work-dir (current-directory))

;; given list of lists
;;  ( ( msg expected param1 param2 ...)
;;    ( ... ) )
;; apply test to all







|
>
>
>
>
>
>
>







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