Megatest

server.scm at [b6ea6cc3d4]
Login

File tests/unittests/server.scm artifact 288618866d part of check-in b6ea6cc3d4


;;======================================================================
;; 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 rmtmod trace http-client apimod dbmod
	launchmod)

(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 dbname ".db/2.db")
(define remote *rmt:remote*)
(define keyvals  '(("SYSTEM" "a")("RELEASE" "b")))

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

(thread-sleep! 2)
(test #f #t (list? (rmt:general-open-connection *rmt:remote* *toppath* ".db/2.db")))

(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 *rmt:remote* *toppath* iface port server-key dbname

(test #f 2 (rmt:get-count-servers *rmt:remote* *toppath*))

(test #f "run2" (rmt:get-run-name-from-id 2))

;; (exit)