Overview
Context
Changes
Modified client.scm
from [06d860ba24]
to [ed3b9950c2].
| ︙ | | |
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
-
+
-
+
|
(thread-start! th1)
(thread-join! th2))))
;; client:launch
;; Need to set the signal handler somewhere other than here as this
;; routine will go away.
;;
(define (client:launch run-id)
(define (client:launch run-id *area-dat*)
(set-signal-handler! signal/int client:signal-handler)
(if (client:setup run-id)
(if (client:setup run-id *area-dat*)
(debug:print-info 2 "connected as client")
(begin
(debug:print 0 "ERROR: Failed to connect as client")
(exit))))
|
Modified tests/unittests/basicserver.scm
from [28cf57e0e6]
to [5005eda3b0].
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
|
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
|
-
+
+
+
-
+
+
+
+
+
+
+
+
+
+
|
;;======================================================================
;; S E R V E R
;;======================================================================
;; 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-for-run *area-dat*)
(string? (getenv "MT_RUN_AREA_HOME"))))
(string? (getenv "MT_RUN_AREA_HOME"))))
;; NON Server tests go here
(test #f #f (db:dbdat-get-path *db*))
(print "db:get-run-name, try one")
(test #f #f (db:get-run-name-from-id *db* *area-dat* run-id))
(test #f #t (string? (db:get-run-name-from-id *db* *area-dat* run-id)))
(print "db:get-run-name, try two")
(test #f #t (string? (db:get-run-name-from-id *db* *area-dat* run-id)))
(print "db:get-run-name, try three")
(test #f #t (string? (db:get-run-name-from-id *db* *area-dat* run-id)))
(print "db:get-run-name, try four")
(test #f #t (string? (db:get-run-name-from-id *db* *area-dat* run-id)))
;; (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
;; (exit)
;; Server tests go here
(print "Start server tests")
(for-each
(lambda (run-id)
(test #f #f (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db *area-dat*) *area-dat*) run-id))
(server:kind-run run-id *area-dat*)
(test "did server start within 20 seconds?"
#t
(let loop ((remtries 20)
|
| ︙ | | |
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
|
(loop (- remtries 1)(tasks:get-server (db:delay-if-busy (tasks:open-db *area-dat*) *area-dat*) run-id)))
res)))))
)
(list 0 1))
(define user (current-user-name))
(define runname "mytestrun")
(define keys (rmt:get-keys))
(define keys (rmt:get-keys *area-dat*))
(define runinfo #f)
(define keyvals '(("SYSTEM" "abc")("RELEASE" "def")))
(define header (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time"))
;; Stuff to test before running client:setup
;;
(test #f #f (tasks:get-server (db:delay-if-busy (tasks:open-db *area-dat*) *area-dat*) 1))
(server:kind-run 1 *area-dat*)
(let loop ((count 5)
(ok (tasks:get-server (db:delay-if-busy (tasks:open-db *area-dat*) *area-dat*) 1)))
(if (and (> count 0)(not ok))
(begin
(print "Waiting for server to start...")
(thread-sleep! 1)
(loop (- count 1)(tasks:get-server (db:delay-if-busy (tasks:open-db *area-dat*) *area-dat*) 1)))
(print "Server started ....")))
(define *start-res* (let* ((server-dat #f)
(iface #f)
(hostname #f)
(port #f)
(remoteconn #f))
(test #f #t (begin (set! server-dat (tasks:get-server (db:delay-if-busy (tasks:open-db *area-dat*) *area-dat*) 1))
(vector? server-dat)))
(test #f #t (begin (set! iface (tasks:hostinfo-get-interface server-dat))
(string? iface)))
(test #f #t (begin (set! hostname (tasks:hostinfo-get-hostname server-dat))
(string? hostname)))
(test #f #t (begin (set! port (tasks:hostinfo-get-port server-dat))
(number? port)))
(test #f #t (begin (set! remoteconn (http-transport:client-connect iface port))
(vector? remoteconn)))
remoteconn))
;; Setup
;;
(test #f #f (not (client:setup run-id)))
(test #f #f (not (hash-table-ref/default *runremote* run-id #f)))
(test #f #f (not (client:setup run-id *area-dat*)))
;; Login
;;
(test #f'(#t "successful login")
(rmt:login-no-auto-client-setup (hash-table-ref/default *runremote* run-id #f) run-id))
(test #f '(#t "successful login")
(rmt:login run-id))
|
| ︙ | | |