30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
;; DEP - function is deprecated, no point in testing
;; NED - function nested under others, no test needed.
;; DEF - deferred
(print "start dir: " (current-directory))
(define toppath (current-directory))
(test #f #t (string?(server:start-and-wait *toppath*)))
(test "setup for run" #t (begin (launch:setup)
(string? (getenv "MT_RUN_AREA_HOME"))))
(test #f #t (vector? (client:setup toppath)))
(test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down.
(test #f #t (string? (server:check-if-running ".")))
;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '()))
;; DEF (rmt:kill-server run-id)
;; DEF (rmt:start-server run-id)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
30
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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
;; DEP - function is deprecated, no point in testing
;; NED - function nested under others, no test needed.
;; DEF - deferred
(print "start dir: " (current-directory))
(define toppath (current-directory))
(test #f #f (server:check-if-running toppath)) ;; these are used by server:start-and-wait
(test #f #t (list? (server:get-list toppath)))
(test #f '() (server:get-best '()))
(test #f #t (common:simple-file-lock-and-wait "test.lock" expire-time: 15))
(test #f "test.lock" (common:simple-file-release-lock "test.lock"))
(test #f #t (server:get-best-guess-address (get-host-name)))
(test #f #t (string? (common:get-homehost)))
;; clean out any old running servers
;;
(let ((servers (server:get-list toppath)))
(print "Known servers: " servers)
(if (not (null? servers))
(begin
(for-each
(lambda (server)
(let ((pid (list-ref server 4)))
(thread-start!
(make-thread
(lambda ()
(print "Attempting to kill server: " server)
(print "Attempting to kill pid " pid)
(system (conc "kill " pid))
(thread-sleep! 2)
(system (conc "kill -9 " pid)))
(conc pid)))))
servers)
(thread-sleep! 2))))
;; let's start up a server the mechanical way
(system "nbfake megatest -server -")
(thread-sleep! 2)
;; (test #f #t (string? (server:start-and-wait *toppath*)))
(test "setup for run" #t (begin (launch:setup)
(string? (getenv "MT_RUN_AREA_HOME"))))
(test #f #t (client:setup-http toppath))
(test #f #t (vector? (client:setup toppath)))
(test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down.
(test #f #t (string? (server:check-if-running ".")))
;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '()))
;; DEF (rmt:kill-server run-id)
;; DEF (rmt:start-server run-id)
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
(list "not-a-host" #t "not-a-host" ))
post-proc: pair?)
(test #f #t (list? (rmt:get-changed-record-ids 0)))
(test #f #f (begin (runs:update-all-test_meta #f) #f))
(test #f '("test1" "test2")(sort (alist-ref "tagtwo" (hash-table->alist (rmt:get-tests-tags)) equal?) string<=))
(test #f '() (rmt:get-key-val-pairs 0))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys-write)) ;; dummy query to force server start
(test #f '() (rmt:get-key-vals 1))
(test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
(test #f "" (rmt:get-target 1))
(test #f #t (rmt:register-test 1 "foo" ""))
(test #f 1 (rmt:get-test-id 1 "foo" ""))
(test #f "foo" (vector-ref (rmt:get-test-info-by-id 1 1) 2))
(test #f "/tmp/badname" (rmt:test-get-rundir-from-test-id 1 1))
(test #f '(1) (db:set-tests-state-status *db* 1 '("foo") "COMPLETED" "PASS" "NOT_STARTED" "PASS"))
(test #f '(1) (rmt:set-tests-state-status 1 '("foo") "COMPLETED" "PASS" "NOT_STARTED" "PASS"))
(test #f #t (mt:test-set-state-status-by-id 1 1 "COMPLETED" "PASS" "Just testing!"))
(test #f #t (list? (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f 0 #f)))
(test #f #t (list? (rmt:get-tests-for-runs-mindata '(1) "%" '() '() #f)))
(test #f #f (begin (rmt:delete-test-records 1 2) #f))
(test #f #t (begin (rmt:test-set-state-status 1 1 "COMPLETED" "FAIL" "Another message") #t))
(test #f 0 (rmt:test-toplevel-num-items 1 "foo"))
|
|
<
|
|
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
|
(list "not-a-host" #t "not-a-host" ))
post-proc: pair?)
(test #f #t (list? (rmt:get-changed-record-ids 0)))
(test #f #f (begin (runs:update-all-test_meta #f) #f))
(test #f '("test1" "test2")(sort (alist-ref "tagtwo" (rmt:get-tests-tags) equal?) string<=))
(test #f '() (rmt:get-key-val-pairs 0))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys-write)) ;; dummy query to force server start
(test #f '() (rmt:get-key-vals 1))
(test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
(test #f "" (rmt:get-target 1))
(test #f #t (rmt:register-test 1 "foo" ""))
(test #f 1 (rmt:get-test-id 1 "foo" ""))
(test #f "foo" (vector-ref (rmt:get-test-info-by-id 1 1) 2))
(test #f "/tmp/badname" (rmt:test-get-rundir-from-test-id 1 1))
;; (test #f '(1) (db:set-tests-state-status *db* 1 '("foo") "COMPLETED" "PASS" "NOT_STARTED" "PASS")) ;; trust that this was tested in all-api
(test #f '(1) (rmt:set-tests-state-status 1 '("foo") "COMPLETED" "PASS" "NOT_STARTED" "PASS"))
(test #f #t (mt:test-set-state-status-by-id 1 1 "COMPLETED" "PASS" "Just testing!"))
(test #f #t (list? (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f 0 #f)))
(test #f #t (list? (rmt:get-tests-for-runs-mindata '(1) "%" '() '() #f)))
(test #f #f (begin (rmt:delete-test-records 1 2) #f))
(test #f #t (begin (rmt:test-set-state-status 1 1 "COMPLETED" "FAIL" "Another message") #t))
(test #f 0 (rmt:test-toplevel-num-items 1 "foo"))
|
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
)
post-proc: (lambda (res)
;; (print "rmt:get-runs-by-patt returned: " res)
(and (vector? res)
(let ((rows (vector-ref res 1)))
(> (length rows) 0))))))
;; (rmt:find-and-mark-incomplete run-id ovr-deadtime)
;; (rmt:get-main-run-stats run-id)
;; (rmt:get-var varname)
;; (rmt:set-var varname value)
;; (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
;; (rmt:get-previous-test-run-record run-id test-name item-path)
;; (rmt:get-run-stats)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
)
post-proc: (lambda (res)
;; (print "rmt:get-runs-by-patt returned: " res)
(and (vector? res)
(let ((rows (vector-ref res 1)))
(> (length rows) 0))))))
(test #f '(("Totals" "UNKNOWN" 1) ("bar" "UNKNOWN" 1)) (begin (rmt:get-run-stats)))
(test #f #t (begin (rmt:set-run-state-status 1 "COMPLETE" "PASS") #t))
(test #f '"COMPLETE" (rmt:get-run-state 1))
(test #f '"PASS" (rmt:get-run-status 1))
(test #f #t (begin (rmt:set-var "foo" "bar")#t))
(test #f "bar" (rmt:get-var "foo"))
(test #f #t (begin (rmt:print-db-stats) #t))
(test #f #t (begin (rmt:del-var "foo") #t))
(test #f #f (rmt:get-var "foo"))
(test #f (vector #f #f #f #f #f #f #f #f #f #f #f #f) (rmt:get-data-info-by-id 1))
(test #f '() (rmt:get-key-vals 1))
(test #f "ubuntu/v1.234" (rmt:get-target 1))
(print (rmt:get-run-info 1))
(test #f '((runs) (tests) (test_steps) (test_data)) (rmt:get-run-record-ids "ubuntu/v1.234" 1 '("fail_count") "bar"))
;; (rmt:find-and-mark-incomplete run-id ovr-deadtime)
;; (rmt:get-main-run-stats run-id)
;; (rmt:get-var varname)
;; (rmt:set-var varname value)
;; (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
;; (rmt:get-previous-test-run-record run-id test-name item-path)
;; (rmt:get-run-stats)
|