8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
"myrun"
"new"
"n/a"
"bob")))
(test #f #t (rmt:register-test 1 "nada" ""))
(test #f 30001 (rmt:get-test-id 1 "nada" ""))
(test #f "NOT_STARTED" (vector-ref (rmt:get-test-info-by-id 1 30001) 3)) ;; "nada" "") 3))
(test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def"))
(test #f "key2" (vector-ref (car (vector-ref (mt:get-runs-by-patt '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1))
(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 "%" "%" "%"))
|
|
|
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
"myrun"
"new"
"n/a"
"bob")))
(test #f #t (rmt:register-test 1 "nada" ""))
(test #f 30001 (rmt:get-test-id 1 "nada" ""))
(test #f "NOT_STARTED" (db:test-state (rmt:get-test-info-by-id 1 30001))) ;; "nada" "") 3))
(test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def"))
(test #f "key2" (vector-ref (car (vector-ref (mt:get-runs-by-patt '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1))
(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 "%" "%" "%"))
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
(rmt:register-test 1 "rollup" itempath)
(let ((test-id (rmt:get-test-id 1 "rollup" itempath))
(comment (conc "This is a comment for itempath " itempath)))
;; (rmt:test-set-state-status-by-id run-id test-id "COMPLETED" "PASS" comment)
(tests:test-set-status! 1 test-id "COMPLETED" "PASS" comment #f))) ;; #!key (work-area #f))
'("item/1" "item/2" "item/3" "item/4" "item/5"))
(test #f #t (number? (rmt:get-test-id 1 "rollup" "item/4")))
(define (get-state-status run-id testname itempath)
(let ((tdat (rmt:get-test-info-by-id 1 (rmt:get-test-id run-id testname itempath))))
(list (db:test-get-state tdat)
(db:test-get-status tdat))))
(test "Rollup PASS" '("COMPLETED" "PASS") (get-state-status 1 "rollup" ""))
(let ((test-id (rmt:get-test-id 1 "rollup" "item/4"))
(top-id (rmt:get-test-id 1 "rollup" "")))
(for-each
(lambda (state status rup-state rup-status)
;; reset to COMPLETED/PASS
|
>
>
>
>
|
|
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
(rmt:register-test 1 "rollup" itempath)
(let ((test-id (rmt:get-test-id 1 "rollup" itempath))
(comment (conc "This is a comment for itempath " itempath)))
;; (rmt:test-set-state-status-by-id run-id test-id "COMPLETED" "PASS" comment)
(tests:test-set-status! 1 test-id "COMPLETED" "PASS" comment #f))) ;; #!key (work-area #f))
'("item/1" "item/2" "item/3" "item/4" "item/5"))
(exit)
(test #f #t (number? (rmt:get-test-id 1 "rollup" "item/4")))
(define (get-state-status run-id testname itempath)
(let ((tdat (rmt:get-test-info-by-id 1 (rmt:get-test-id run-id testname itempath))))
(list (db:test-state tdat)
(db:test-status tdat))))
(test "Rollup PASS" '("COMPLETED" "PASS") (get-state-status 1 "rollup" ""))
(let ((test-id (rmt:get-test-id 1 "rollup" "item/4"))
(top-id (rmt:get-test-id 1 "rollup" "")))
(for-each
(lambda (state status rup-state rup-status)
;; reset to COMPLETED/PASS
|
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
(change-directory test-work-dir)
(test #f #t (> (length (mt:get-tests-for-run 1 "test1" '() '())) 0))
(test "Add a step" #t
(begin
(rmt:teststep-set-status! 1 30002 "step1" "start" 0 "This is a comment" "mylogfile.html")
(sleep 2)
(rmt:teststep-set-status! 1 30002 "step1" "end" "pass" "This is a different comment" "finallogfile.html")
(set! test-id (db:test-get-id (car (mt:get-tests-for-run 1 "test1" '() '()))))
(number? test-id)))
(test "Get rundir" #t (let ((rundir (cdb:remote-run db:test-get-rundir-from-test-id #f test-id)))
(print "Rundir " rundir)
(system (conc "mkdir -p " rundir))
(string? rundir)))
(test #f #t (sqlite3#database? (open-test-db "./")))
|
|
|
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
|
(change-directory test-work-dir)
(test #f #t (> (length (mt:get-tests-for-run 1 "test1" '() '())) 0))
(test "Add a step" #t
(begin
(rmt:teststep-set-status! 1 30002 "step1" "start" 0 "This is a comment" "mylogfile.html")
(sleep 2)
(rmt:teststep-set-status! 1 30002 "step1" "end" "pass" "This is a different comment" "finallogfile.html")
(set! test-id (db:test-id (car (mt:get-tests-for-run 1 "test1" '() '()))))
(number? test-id)))
(test "Get rundir" #t (let ((rundir (cdb:remote-run db:test-get-rundir-from-test-id #f test-id)))
(print "Rundir " rundir)
(system (conc "mkdir -p " rundir))
(string? rundir)))
(test #f #t (sqlite3#database? (open-test-db "./")))
|
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
|
;; now set all tests to completed
(cdb:flush-queue *runremote*)
(let ((tests (cdb:remote-run db:get-tests-for-run #f 1 "%" '() '())))
(print "Setting " (length tests) " to COMPLETED/PASS")
(for-each
(lambda (test)
(cdb:test-set-status-state *runremote* (db:test-get-id test) "COMPLETED" "PASS" "Forced pass"))
tests))
;; (process-wait server-pid)
;; (test "Server wait time" #t (let ((run-delta (- (current-seconds) start-wait)))
;; (print "Server ran for " run-delta " seconds")
;; (> run-delta 20)))
|
|
|
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
|
;; now set all tests to completed
(cdb:flush-queue *runremote*)
(let ((tests (cdb:remote-run db:get-tests-for-run #f 1 "%" '() '())))
(print "Setting " (length tests) " to COMPLETED/PASS")
(for-each
(lambda (test)
(cdb:test-set-status-state *runremote* (db:test-id test) "COMPLETED" "PASS" "Forced pass"))
tests))
;; (process-wait server-pid)
;; (test "Server wait time" #t (let ((run-delta (- (current-seconds) start-wait)))
;; (print "Server ran for " run-delta " seconds")
;; (> run-delta 20)))
|