110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
-
+
|
(and (file-exists? "nada.sh")
(file-exists? "nada.csh"))))
(test "get all legal tests" (list "test1" "test2") (sort (get-all-legal-tests) string<=?))
(test "register-test, test info" "NOT_STARTED"
(begin
(rdb:tests-register-test *db* 1 "nada" "")
(cdb:tests-register-test *remoterun* 1 "nada" "")
;; (rdb:flush-queue)
(vector-ref (db:get-test-info *db* 1 "nada" "") 3)))
(test #f "NOT_STARTED"
(begin
(rdb:tests-register-test #f 1 "nada" "")
;; (rdb:flush-queue)
|
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
+
|
"n/a"
"bob")))
(define keys (db:get-keys *db*))
;;======================================================================
;; D B
;;======================================================================
(test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def"))
(test #f (vector '("SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time") '())
(runs:get-runs-by-patt db keys "%"))
(test #f "SYSTEM,RELEASE,id,runname,state,status,owner,event_time" (car (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time"))))
(test #f #t (runs:operate-on 'print "%" "%" "%"))
;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada"
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
|
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
|
-
-
+
+
+
+
+
+
-
+
|
;;======================================================================
;; R E M O T E C A L L S
;;======================================================================
;; start a server process
(set! *verbosity* 10)
(define server-pid (process-run "../../bin/megatest" (list "-server" "-" "-debug" (conc *verbosity*))))
(sleep 2)
;; (define server-pid (process-run "../../bin/megatest" (list "-server" "-" "-debug" (conc *verbosity*))))
;; (sleep 2)
(define th1 (make-thread server:launch))
(thread-start! th1)
(define start-wait (current-seconds))
(server:client-setup)
(print "Starting intensive cache and rpc test")
(for-each (lambda (params)
;;; (rdb:tests-register-test #f 1 (conc "test" (random 20)) "")
(apply rdb:test-set-status-state test-id params)
(apply cdb:test-set-status-state *remoterun* test-id params)
(rdb:pass-fail-counts test-id (random 100) (random 100))
(rdb:test-rollup-test_data-pass-fail test-id)
(thread-sleep! 0.01)) ;; cache ordering granularity is at the second level. Should really be at the ms level
'(("COMPLETED" "PASS" #f)
("NOT_STARTED" "FAIL" "Just testing")
("NOT_STARTED" "FAIL" "Just testing")
("NOT_STARTED" "FAIL" "Just testing")
|