290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
(string-match (regexp "\\S+") comment))
waived)
(let ((cmt (if waived waived comment)))
(rmt:general-call 'set-test-comment 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))
(db:get-query 'tests:test-set-toplog)
(db:save-string dbstruct logf)
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))
|
<
<
<
|
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
(string-match (regexp "\\S+") comment))
waived)
(let ((cmt (if waived waived comment)))
(rmt:general-call 'set-test-comment 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))
(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))
|
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
|
(define (tests:update-central-meta-info dbstruct run-id test-id cpuload diskfree minutes uname hostname)
(rmt:general-call 'update-cpuload-diskfree cpuload diskfree test-id)
(if minutes
(rmt:general-call 'update-run-duration minutes test-id))
(if (and uname hostname)
(rmt:general-call 'update-uname-host uname hostname test-id)))
(define (tests:set-full-meta-info test-id run-id minutes work-area)
(let* ((num-records 0)
(define (tests:set-full-meta-info dbstruct test-id run-id minutes work-area)
(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 dbstruct 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)))
;;======================================================================
;; A R C H I V I N G
|
|
<
|
|
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
|
(define (tests:update-central-meta-info dbstruct run-id test-id cpuload diskfree minutes uname hostname)
(rmt:general-call 'update-cpuload-diskfree cpuload diskfree test-id)
(if minutes
(rmt:general-call 'update-run-duration minutes test-id))
(if (and uname hostname)
(rmt:general-call 'update-uname-host uname hostname test-id)))
(define (tests:set-full-meta-info dbstruct 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 dbstruct 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)))
;;======================================================================
;; A R C H I V I N G
|