194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
-
+
-
+
|
result)))))
(define (tests:test-force-state-status! test-id state status)
(rmt:test-set-status-state test-id status state #f)
(mt:process-triggers test-id state status))
;; Do not rpc this one, do the underlying calls!!!
(define (tests:test-set-status! test-id state status comment dat #!key (work-area #f))
(define (tests:test-set-status! run-id test-id state status comment dat #!key (work-area #f))
(let* ((real-status status)
(otherdat (if dat dat (make-hash-table)))
(testdat (rmt:get-test-info-by-id test-id))
(testdat (rmt:get-test-info-by-id run-id test-id))
(run-id (db:test-get-run_id testdat))
(test-name (db:test-get-testname testdat))
(item-path (db:test-get-item-path testdat))
;; before proceeding we must find out if the previous test (where all keys matched except runname)
;; was WAIVED if this test is FAIL
;; NOTES:
|
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
-
+
-
+
|
(if (not (equal? item-path ""))
(rmt:roll-up-pass-fail-counts run-id test-name item-path status))
(if (or (and (string? comment)
(string-match (regexp "\\S+") comment))
waived)
(let ((cmt (if waived waived comment)))
(rmt:general-call 'set-test-comment cmt test-id)))))
(rmt:general-call 'set-test-comment run-id cmt test-id)))))
(define (tests:test-set-toplog! run-id test-name logf)
(rmt:general-call 'tests:test-set-toplog logf run-id test-name))
(rmt:general-call 'tests:test-set-toplog run-id logf run-id test-name))
(define (tests:summarize-items run-id test-id test-name force)
;; if not force then only update the record if one of these is true:
;; 1. logf is "log/final.log
;; 2. logf is same as outputfilename
(let* ((outputfilename (conc "megatest-rollup-" test-name ".html"))
(orig-dir (current-directory))
|
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
|
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
|
-
-
+
+
-
-
+
+
-
+
-
+
-
+
|
;;======================================================================
;; test steps
;;======================================================================
;; teststep-set-status! used to be here
(define (test-get-kill-request test-id) ;; run-id test-name itemdat)
(let* ((testdat (rmt:get-test-info-by-id test-id)))
(define (test-get-kill-request run-id test-id) ;; run-id test-name itemdat)
(let* ((testdat (rmt:get-test-info-by-id run-id test-id)))
(and testdat
(equal? (test:get-state testdat) "KILLREQ"))))
(define (test:tdb-get-rundat-count tdb)
(if tdb
(let ((res 0))
(sqlite3:for-each-row
(lambda (count)
(set! res count))
tdb
"SELECT count(id) FROM test_rundat;")
res))
0)
(define (tests:update-central-meta-info test-id cpuload diskfree minutes uname hostname)
(rmt:general-call 'update-cpuload-diskfree cpuload diskfree test-id)
(define (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname)
(rmt:general-call 'update-cpuload-diskfree run-id cpuload diskfree test-id)
(if minutes
(rmt:general-call 'update-run-duration minutes test-id))
(rmt:general-call 'update-run-duration run-id minutes test-id))
(if (and uname hostname)
(rmt:general-call 'update-uname-host uname hostname test-id)))
(rmt:general-call 'update-uname-host run-id uname hostname test-id)))
(define (tests:set-full-meta-info test-id run-id minutes work-area)
(let* ((num-records 0)
(cpuload (get-cpu-load))
(diskfree (get-df (current-directory)))
(uname (get-uname "-srvpio"))
(hostname (get-host-name)))
(tdb:update-testdat-meta-info test-id work-area cpuload diskfree minutes)
(tests:update-central-meta-info test-id cpuload diskfree minutes uname hostname)))
(tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname)))
(define (tests:set-partial-meta-info test-id run-id minutes work-area)
(let* ((cpuload (get-cpu-load))
(diskfree (get-df (current-directory))))
(tdb:update-testdat-meta-info test-id work-area cpuload diskfree minutes)))
;;======================================================================
|