Megatest

Check-in [51225a42e5]
Login
Overview
Comment:Unit test coming along.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-ck5
Files: files | file ages | folders
SHA1: 51225a42e523bd0e5c5025f221b73a26b997f4ad
User & Date: matt on 2021-05-08 22:47:54
Other Links: branch diff | manifest | tags
Context
2021-05-09
23:42
Simplify running of unit tests, simplified ping check-in: 0453b5d22b user: matt tags: v1.6584-ck5
2021-05-08
22:47
Unit test coming along. check-in: 51225a42e5 user: matt tags: v1.6584-ck5
2021-05-05
05:45
Prepped unit tests for adding basicserver tests. check-in: 2d52196991 user: matt tags: v1.6584-ck5
Changes

Modified rmtmod.scm from [47299d0079] to [68e1f7f6c8].

206
207
208
209
210
211
212

213
214
215
216
217
218
219
220
221
222

223
224
225
226
227
228
229
    (if the-srv ;; yes, we have a server, now try connecting to it
	(let* ((srv-addr (server-address the-srv))
	       (ipaddr   (alist-ref 'ipaddr the-srv))
	       (port     (alist-ref 'port   the-srv))
	       (srvready (server-ready? ipaddr port))
	       (fullpath (db:dbname->path apath dbname)))
	  (if srvready

	      (hash-table-set! (rmt:remote-conns remote)
			       fullpath
			       (make-rmt:conn
				apath:   apath
				dbname:  dbname
				fullname: fullpath
				hostport: srv-addr
				lastmsg: (current-seconds)
				expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
				))

	      (start-main-srv)))
	(start-main-srv))))

;; NB// remote is a rmt:remote struct
;;
(define (rmt:general-open-connection remote apath dbname)
  (let  ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))







>
|
|
|
|
|
|
|
|
|
|
>







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    (if the-srv ;; yes, we have a server, now try connecting to it
	(let* ((srv-addr (server-address the-srv))
	       (ipaddr   (alist-ref 'ipaddr the-srv))
	       (port     (alist-ref 'port   the-srv))
	       (srvready (server-ready? ipaddr port))
	       (fullpath (db:dbname->path apath dbname)))
	  (if srvready
	      (begin
		(hash-table-set! (rmt:remote-conns remote)
				 fullpath
				 (make-rmt:conn
				  apath:   apath
				  dbname:  dbname
				  fullname: fullpath
				  hostport: srv-addr
				  lastmsg: (current-seconds)
				  expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
				  ))
		#t)
	      (start-main-srv)))
	(start-main-srv))))

;; NB// remote is a rmt:remote struct
;;
(define (rmt:general-open-connection remote apath dbname)
  (let  ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))

Modified tests/Makefile from [9ee0726286] to [b8d7fd37e9].

38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53
# The NEWTARGET causes some tests to fail. Do not use until this is fixed.
NEWTARGET  = "$(OS)/$(FS)/$(VER)"
TARGET     = "ubuntu/nfs/none"

all : build unit test4
# test1 test2 test3 test4 test5 test6 test7 test8 test9

unit : basicserver.log all-rmt.log all-api.log

# basicserver.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 &








|
>
|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
# The NEWTARGET causes some tests to fail. Do not use until this is fixed.
NEWTARGET  = "$(OS)/$(FS)/$(VER)"
TARGET     = "ubuntu/nfs/none"

all : build unit test4
# test1 test2 test3 test4 test5 test6 test7 test8 test9

unit : basicserver.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 &

Modified tests/rununittest.sh from [1c340ef384] to [105cb093b4].

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
# put megatest on path from correct location
mtbindir=$(readlink -f ../bin)
 
export PATH="${mtbindir}:$PATH"

# Clean setup
#
dbdir=$(echo /tmp/$USER/megatest_localdb/simplerun/.[a-zA-Z]*/)
echo "dbdir=$dbdir"
rm -f simplerun/megatest.db simplerun/monitor.db simplerun/db/monitor.db
rm -rf simplelinks/ simpleruns/ simplerun/db/ $dbdir
mkdir -p simplelinks simpleruns
(cd simplerun;cp ../../*_records.scm .;perl -pi.bak -e 's/define-inline/define/' *_records.scm)
(cd simplerun;cp ../../altdb.scm .)

# Run the test $1 is the unit test to run
cd simplerun;echo '(load "../tests.scm")' | ../../bin/megatest -repl -debug $2 $1







<
<
|
|






24
25
26
27
28
29
30


31
32
33
34
35
36
37
38
# put megatest on path from correct location
mtbindir=$(readlink -f ../bin)
 
export PATH="${mtbindir}:$PATH"

# Clean setup
#


rm -rf simplerun/megatest.db simplerun/.db simplerun/.meta
rm -rf simplelinks/ simpleruns/ simplerun/db/
mkdir -p simplelinks simpleruns
(cd simplerun;cp ../../*_records.scm .;perl -pi.bak -e 's/define-inline/define/' *_records.scm)
(cd simplerun;cp ../../altdb.scm .)

# Run the test $1 is the unit test to run
cd simplerun;echo '(load "../tests.scm")' | ../../bin/megatest -repl -debug $2 $1

Modified tests/tests.scm from [5559385436] to [2fa2f9d268].

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)

(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
;;     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

Modified tests/unittests/basicserver.scm from [1ad757cf41] to [0c881772ab].

18
19
20
21
22
23
24













25
26
27
28
29
30
31
32
;;     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)














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

;; (test "setup for run" #t (begin (launch:setup)
;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;; 
;; (test #f #t (and (server:kind-run *toppath*) #t))
;; 







>
>
>
>
>
>
>
>
>
>
>
>
>
|







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
;;     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)
(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*))

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

;; (test "setup for run" #t (begin (launch:setup)
;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;; 
;; (test #f #t (and (server:kind-run *toppath*) #t))
;;