Megatest

Check-in [421c5670ac]
Login
Overview
Comment:Added beginnings of stress test for nng transport
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.001
Files: files | file ages | folders
SHA1: 421c5670ac5e2a3160bba4810773f7c198f48653
User & Date: matt on 2021-12-21 18:54:28
Other Links: branch diff | manifest | tags
Context
2021-12-22
19:51
Looking a resurecting ulex - but without all the stuff beyond a transport layer. check-in: f88b668106 user: matt tags: v2.001
2021-12-21
18:54
Added beginnings of stress test for nng transport check-in: 421c5670ac user: matt tags: v2.001
17:47
all-rmt unit tests pass check-in: 9f85a4b1dd user: matt tags: v2.001
Changes

Modified tests/Makefile from [7641740d8e] to [94290eecf3].

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
# test1 test2 test3 test4 test5 test6 test7 test8 test9

unit : basicserver.log server.log all-rmt.log
# all-rmt.log all-api.log
# runs.log misc.log tests.log

# inter dependencies on the unit tests, I wish these could be "suggestions"
all-rmt.log : all-api.log

rel : 
	cd release;dashboard -rows 25 &

## basicserver.log : unittests/basicserver.scm
## 	script -c "./rununittest.sh basicserver $(DEBUG)" basicserver.log








|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
# test1 test2 test3 test4 test5 test6 test7 test8 test9

unit : basicserver.log server.log all-rmt.log
# all-rmt.log all-api.log
# runs.log misc.log tests.log

# inter dependencies on the unit tests, I wish these could be "suggestions"
# all-rmt.log : all-api.log

rel : 
	cd release;dashboard -rows 25 &

## basicserver.log : unittests/basicserver.scm
## 	script -c "./rununittest.sh basicserver $(DEBUG)" basicserver.log

Added tests/simplerun/stress-test.scm version [f0fdd4cdcf].













































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
;;======================================================================
;; S E R V E R
;;======================================================================
;;  Copyright 2006-2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     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/>.


;; Run like this:
;;
;;  (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)
(import big-chicken
	chicken.random
	test
	srfi-18
	
	rmtmod
	trace
	apimod
	dbmod
	launchmod
	commonmod
	)

(trace-call-sites #t)
(trace
   
 ;; db:get-dbdat
 ;; rmt:find-main-server
 ;; rmt:send-receive-real
 ;; rmt:send-receive
 ;; sexpr->string
 ;; server-ready?
 ;; rmt:register-server
 ;;  rmt:deregister-server
 ;; rmt:open-main-connection
 ;; rmt:general-open-connection
 ;; rmt:get-conn
 ;; common:watchdog
 ;; rmt:find-main-server
 ;; get-all-server-pkts
 ;; get-viable-servers
 ;; get-best-candidate
 ;; api:run-server-process
 ;; api:process-request
 ;; rmt:run
 ;; rmt:try-start-server
 )


(define *db* (db:setup ".db/main.db"))

;; these let me cut and paste from source easily
(define apath *toppath*)
(define run-id (pseudo-random-integer 10))
(define dbname (conc ".db/"run-id".db"))
(define remote *remotedat*)
(define keyvals  '(("SYSTEM" "a")("RELEASE" "b")))

(test #f #t (rmt:open-main-connection remote apath))
(test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db")))
(test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db")))
(test #f dbname (list-ref (rmt:send-receive-real *remotedat* *toppath* ".db/main.db" 'get-server `(,apath ,dbname))
			      6))

(thread-sleep! 2)
(test #f #t (rmt:general-open-connection *remotedat* *toppath* dbname))

(let loop ((end-time (+ (current-seconds) 600)))
  (test #f #t (list? (rmt:get-servers-info *toppath*)))

  (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
  (test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
  ;; (print "Got here.")

  (test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))

  (test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
  ;; (test #f 2 (rmt:deregister-server *remotedat* *toppath* iface port server-key dbname

  (test #f #t (number? (rmt:get-count-servers *remotedat* *toppath*)))

  (test #f "run2" (rmt:get-run-name-from-id 2))
  (test #f #f     (rmt:send-receive 'get-test-info-by-id 2 '(2 1)))
  
  (test #f #t     (rmt:general-call 'update-cpuload-diskfree 2 1.5 1e6 1))
  (if (< (current-seconds) end-time)(loop end-time)))

(exit)