Megatest

Diff
Login

Differences From Artifact [4fd1b18b7f]:

To Artifact [6f473a99fc]:


1
2
3
4




5
6
7
8
9
10
11
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15




+
+
+
+







;;======================================================================
;; S E R V E R
;;======================================================================

;; Run like this:
;;
;;  (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

(set! *transport-type* 'http)

(test "setup for run" #t (begin (setup-for-run)
				(string? (getenv "MT_RUN_AREA_HOME"))))

(test "server-register, get-best-server" #t (let ((res #f))
					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live 'http)
27
28
29
30
31
32
33
34
35
36



37
38
39
40
41







42
43
44
45
46
47
48
31
32
33
34
35
36
37



38
39
40

41
42
43

44
45
46
47
48
49
50
51
52
53
54
55
56
57







-
-
-
+
+
+
-



-
+
+
+
+
+
+
+







(system "megatest -server - &")

(thread-sleep! 3) ;; need to wait for server to start. Yes, a better way is needed.
(test "get-best-server" #t (begin 
			     (client:launch)
			     (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
			       (vector? dat))))
;; (print "dat: " dat)
;; (set! *runremote* (list (vector-ref dat 1)(vector-ref dat 2) #f)) ;; host ip pullport pubport
;; (and (string? (car  *runremote*))

(define *keys*               (keys:config-get-fields *configdat*))
(define *keyvals*            (keys:target->keyval *keys* "a/b/c"))
;; 	  (number? (cadr *runremote*)))))

(test #f #t                       (string? (car *runremote*)))
(test #f '(#t "successful login") (rmt:login)) ;;  *runremote* *toppath* *my-client-signature*)))
(test #f #f                       (rmt:get-test-info-by-id 99))
(test #f #f                       (rmt:get-test-info-by-id 99)) ;; get non-existant test
(test #f 1                        (rmt:register-run  *keyvals* "firstrun" "new" "n/a" (current-user-name)))
(test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
				    (vector-ref (vector-ref rinfo 1) 3)))
(test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
(test "register test"       #t    (rmt:general-call 'register-test 1 "test1" ""))
(test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))

;; ;; (set! *verbosity* 20)
;; (test #f *verbosity* (cadr (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*)
;; 
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84

85
86







-
+

;; (test #f "NOT_STARTED"  (vector-ref (open-run-close db:get-test-info #f 1 "nada" "") 3))
;; (test #f "NOT_STARTED"  (vector-ref (cdb:get-test-info *runremote* 1 "nada" "") 3))

;;======================================================================
;; D B
;;======================================================================

(test #f #f (cdb:kill-server *runremote* #f)) ;; *toppath* *my-client-signature* #f)))
(test #f '(#t "exit process started") (cdb:kill-server *runremote* #f)) ;; *toppath* *my-client-signature* #f)))