Megatest

Check-in [bda352d54b]
Login
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: bda352d54b2f903376bd94ab6581a9035403afad
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
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 ()







|







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
245
246
247
248
249
250
251
252
  (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 (http-transport:send-receive mainconn "x" 'get-server `(,apath ,dbname))))
	  (print "rmt:general-open-connection got res="res)))))
	  

;;======================================================================

;; Defaults to 
;;







|







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
273
274
275
276
277
278
279
280
281
    (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)







|
|







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
1546
1547
1548
1549
1550
1551
1552
1553
;; 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)))
    (http-transport: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)))







|







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
25
26
27
28
29
30
31
32
33
34
35
36
37
38

39
40
41








42
43
44
45
46
47
48
;;     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)
(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))









;; (delete-file* "logs/1.log")
;; (define run-id 1)

;; (test "setup for run" #t (begin (launch:setup)
;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;; 







|













>



>
>
>
>
>
>
>
>







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"))))
;;