Overview
| Comment: | Working on unit tests |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | multi-area |
| Files: | files | file ages | folders |
| SHA1: |
5770402337f10ebf81b2bd5056b55a25 |
| User & Date: | matt on 2015-04-16 00:00:43 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-05-27
| ||
| 20:58 | Oops. Borked merge to side. Closed-Leaf check-in: f9f4c1c4ea user: matt tags: borked-merge | |
|
2015-05-06
| ||
| 20:51 | Merged latest fixes from v1.60 to multi-area check-in: 2d67113627 user: matt tags: multi-area | |
|
2015-04-16
| ||
| 00:00 | Working on unit tests check-in: 5770402337 user: matt tags: multi-area | |
|
2015-04-12
| ||
| 23:58 | Cleaned up dup in rmt.scm. Part of gather data in dashboard check-in: 3354a201a4 user: matt tags: multi-area | |
Changes
Modified client.scm from [06d860ba24] to [ed3b9950c2].
| ︙ | ︙ | |||
233 234 235 236 237 238 239 |
(thread-start! th1)
(thread-join! th2))))
;; client:launch
;; Need to set the signal handler somewhere other than here as this
;; routine will go away.
;;
| | | | 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 *area-dat*)
(set-signal-handler! signal/int client:signal-handler)
(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 | ;;====================================================================== ;; 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*) | | > > | > > > > > > > > > | 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"))))
;; NON Server tests go here
(test #f #f (db:dbdat-get-path *db*))
(print "db:get-run-name, try one")
(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 | (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") | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | 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 *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 *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))
|
| ︙ | ︙ |