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