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
117
118
|
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
117
118
119
120
|
-
-
-
-
+
+
+
+
+
-
+
-
-
-
-
+
+
+
+
-
+
+
+
+
-
+
-
+
-
-
|
;;======================================================================
;; S E R V E R
;;======================================================================
(test "setup for run" #t (begin (setup-for-run)
(string? (getenv "MT_RUN_AREA_HOME"))))
(test "server-register, get-best-server" '("bob" 1234) (let ((res #f))
(open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live)
(set! res (open-run-close tasks:get-best-server tasks:open-db))
res))
(test "server-register, get-best-server" #t (let ((res #f))
(open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 1235 100 'live)
(set! res (open-run-close tasks:get-best-server tasks:open-db))
(number? (cadddr res))))
(test "de-register server" #t (let ((res #f))
(open-run-close tasks:server-deregister tasks:open-db "bob" port: 1234)
(open-run-close tasks:server-deregister tasks:open-db "bob" pullport: 1234)
(list? (open-run-close tasks:get-best-server tasks:open-db))))
(define hostinfo #f)
(test #f #t (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
(set! hostinfo dat)
(and (string? (car dat))
(number? (cadr dat)))))
(test "get-best-server" #t (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
(set! hostinfo dat) ;; host ip pullport pubport
(and (string? (car dat))
(number? (caddr dat)))))
(test #f #t (let ((zmq-socket (apply server:client-connect hostinfo)))
(test #f #t (let ((zmq-socket (server:client-connect
(cadr hostinfo)
(caddr hostinfo)
(cadddr hostinfo))))
(set! *runremote* zmq-socket)
(socket? *runremote*)))
(socket? (vector-ref *runremote* 0))))
(test #f #t (let ((res (server:client-login *runremote*)))
(car res)))
(test #f #t (socket? *runremote*))
(test #f #t (socket? (vector-ref *runremote* 0)))
;; (test #f #t (server:client-setup))
(test #f #t (car (cdb:login *runremote* *toppath* *my-client-signature*)))
(test #f #t (open-run-close tasks:get-best-server tasks:open-db))
;;======================================================================
;; C O N F I G F I L E S
;;======================================================================
(define conffile #f)
(test "Read a config" #t (hash-table? (read-config "test.config" #f #f)))
(test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f)))
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
-
+
|
(list "pass" "fail" "n/a"))
(test "write env files" "nada.csh" (begin
(save-environment-as-files "nada")
(and (file-exists? "nada.sh")
(file-exists? "nada.csh"))))
(test #f #t (cdb:client-call *runremote* 'immediate #f (lambda ()(display "Got here eh!?") #t)))
(test #f #t (cdb:client-call *runremote* 'immediate #f 1 (lambda ()(display "Got here eh!?") #t)))
;; (set! *verbosity* 20)
(test #f *verbosity* (cdb:set-verbosity *runremote* *verbosity*))
(test #f #f (cdb:roll-up-pass-fail-counts *runremote* 1 "test1" "" "PASS"))
;; (set! *verbosity* 1)
;; (cdb:set-verbosity *runremote* *verbosity*)
|